PDA

View Full Version : Combining Multiple Workbooks / Worksheets



PianoMan5
07-12-2012, 12:49 PM
I've come a long way in the week I've been doing my macros! :whistle:

Anyways, please review the code below as sometimes it works perfectly then when I rerun it again, it messes up...I'm getting issues with blanks in between "pastes" and also trying to remove the headers (I'm trying it by doing a filter).

Can you please help?! :help

Sub Combine_Worksheets()
'This will copy data from all sheets of the selected workbooks
'To a sheet named 'Data' in the sheet in which the macro is run from
Dim pasterow As Integer
Dim LastRow As Long
Dim LastCol As Long
Dim MsgAnswer As VbMsgBoxResult
Dim mainsheetname As String
Dim HeaderRow As Integer
mainsheetname = ActiveWorkbook.Name
MsgAnswer = MsgBox("Please select all excel workbooks to combine _
(use keyboard key CTL to select all) then click Open." _
& vbNewLine & vbNewLine & "*Ensure the headers for each workbook/worksheet is the EXACT same as " _
& "otherwise the consolidated " & "data will be skewed.", vbOKCancel, "Workbook Locator")
If MsgAnswer = vbCancel Then Exit Sub
filestoopen = Application.GetOpenFilename(MultiSelect:=True)
If Not ActiveSheet.Name = "Data" Then ActiveSheet.Name = "Data"
Worksheets("Data").Select
'open workbooks
For Each w In filestoopen
Application.DisplayAlerts = False
Workbooks.Open Filename:=w
copysheetname = ActiveWorkbook.Name
'copy and paste sheets
For Each sh In Worksheets
Application.DisplayAlerts = False
sheetnumber = sh.Index
'something = Worksheets(sheetnumber).UsedRange.Rows.Count + 1
If WorksheetFunction.CountA(Cells) > 0 Then
'Searches for the last cell with data and retreives the row and column #s
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
LastCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Range("A1", Cells(LastRow, LastCol)).Copy
End If
Worksheets(sheetnumber).UsedRange.Copy
Workbooks(mainsheetname).Activate
pasterow =Workbooks(mainsheetname).Worksheets("Data").UsedRange _
.Rows.Count + 1
If pasterow = 2 Then pasterow = 1
Workbooks(mainsheetname).Worksheets("Data").Range("A" & pasterow) _
.Select
ActiveSheet.Paste
Workbooks(copysheetname).Activate
Next sh
Application.DisplayAlerts = False
ActiveWorkbook.Close
Next w
Workbooks(mainsheetname).Worksheets("Data").Activate
Range("A1:AN65000").Select
Selection.Columns.AutoFit
Selection.Rows.AutoFit
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:=Range("A1").Value
Rows("3:65000").Delete
Selection.AutoFilter
'Filters for all headers (according to the initial header on row A and deletes them
Application.DisplayAlerts = True

End Sub

PianoMan5
07-12-2012, 06:14 PM
Would someone be able to point me in the right direction? I've reviewed and reviewed the code (I picked / gathered from the internet and made my own modifications to it...) and simply cannot understand the failures. I've noted some of the code as comments where I've tried and retried. :(

Again, any help provided would be sincerely appreciated. :)

Aussiebear
07-12-2012, 07:02 PM
Where does the code fail? Since we don't have access to your workbooks, you need to tell us where the code fails, what the error message is, and what you were doing at the time the error occurred.

Also use Option Explicit at the top of your code, this will pick up variables not defined or typo's. Its a great way to correct issues in coding when starting out

Also try not to use .Select where possible. The following can be adjusted from

Workbooks(mainsheetname).Worksheets("Data").Activate
Range("A1:AN65000").Select
Selection.Columns.AutoFit
Selection.Rows.AutoFit
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:=Range("A1").Value
Rows("3:65000").Delete
Selection.AutoFilter
to

Workbooks(mainsheetname).Worksheets("Data").Activate
With Range("A1:AN65000")
.Columns.AutoFit
.Rows.AutoFit
With Rows("1:1")
.AutoFilter
With Range("A:A").AutoFilter Field:=1, Criteria1:=Range("A1").Value
Rows("3:65000").Delete
Selection.AutoFilter
end With
End With
End With

PianoMan5
07-12-2012, 07:11 PM
Aussiebear...would you advise as to the issues which can be caused with .select? My ignorance can only be alleviated by knowledge! :)

As to your initial question, I'm not getting any errors par se...just not getting the results I expect. There are blanks after combining workbooks at the top of my consolidated worksheet and it usually comes around the filtering part, when I try to find the headers from the other worksheets and remove them. It seems to copy and paste accurately but I cannot for the life of me figure out the header thing; the workaround is getting to the code where it starts to filter but stopt and have the user remove them but I find that tidious and want the macro to scrub/clean it up.

As a side note (maybe additional feedback from an experienced VBA user? :hi: )...rather than use UsedRange.copy in my code, I figured out how to attain the last row/column of the last used cell; I don't understand why UsedRange sometimes picks up entirely blank rows at the bottom of the worksheet when no data are in the rows (that I can see).