I am trying to create vba to consolidate multiple sheets into a single master sheet by matching Column Headers. I have found multiple threads and documents from microsoft but I'm still coming up short. I have grabbed alot from other users and added my needed twist. Here is what I have...
Option Compare Text
Sub cc()
Dim Sheet As Worksheet
Dim DestSheet As Worksheet
Dim Last As Long
Dim SheetLast As Long
Dim CopyRange As Range
Dim StartRow As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set DestSheet = Sheet("Database_Headers")
StartRow = 2
For Each Sheet In ActiveWorkbook.Worksheets
If LCase(Left(Sheet.Name, 6)) = "Demand" Then
Last = DestSheet.Cells(Rows.Count, "A").End(xlUp).Row
SheetLast = Sheet.Cells(Rows.Count, "A").End(xlUp).Row
If SheetLast > 0 And SheetLast >= StartRow Then
Sheet.Select
Region_Name = WorksheetFunction.Match("Region Name", Rows("1:1"), 0)
location_code = WorksheetFunction.Match("location_code", Rows("1:1"), 0)
location_name = WorksheetFunction.Match("location_name", Rows("1:1"), 0)
dealer_code = WorksheetFunction.Match("dealer_code", Rows("1:1"), 0)
Sheet.Columns(Region_Name).Copy Destination:=DestSheet.Range("C" & Last + 1)
Sheet.Columns(location_code).Copy Destination:=DestSheet.Range("D" & Last + 1)
Sheet.Columns(location_name).Copy Destination:=DestSheet.Range("E" & Last + 1)
Sheet.Columns(dealer_code).Copy Destination:=DestSheet.Range("F" & Last + 1)
End If
End If
CopyRange.Copy
With DestSheet.Cells(Last + 1, "C")
End With
DestSheet.Cells(Last + 1, "B").Resize(CopyRng.Rows.Count).Value = Sheet.Name
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
My Current error is coming from:
Set DestSheet = Sheet("Database_Headers")
but I am not sure if I am needing to clarify further or if I need to add a further clarifying line.
Thank you all in advance for any help!!!
EDIT UPDATE
I have updated the code to:
Option Compare Text
Sub cc()
Dim Sh As Worksheet
Dim DestSheet As Worksheet
Dim Last As Long
Dim SheetLast As Long
'Dim CopyRange As Range
Dim StartRow As Long
'Disables screen updates so screen does not flicker when code is running
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Clarify the summary tab
Set DestSheet = Worksheets("Database_Headers")
' Will not copy column headers and will only copy data
StartRow = 2
'Will copy all data from each sheet that has a different name then the summary tab
For Each Sh In ActiveWorkbook.Worksheets
If LCase(Left(Sh.Name, 6)) = "Demand" Then
Last = DestSheet.Cells(Rows.Count, "B").End(xlUp).Row
shLast = Sh.Cells(Rows.Count, "A").End(xlUp).Row
If shLast > 0 And shLast >= StartRow Then
`Set CopyRange = Sh.Select`
Region_Name = WorksheetFunction.Match("Region Name", Rows("1:1"), 0)
location_code = WorksheetFunction.Match("location_code", Rows("1:1"), 0)
location_name = WorksheetFunction.Match("location_name", Rows("1:1"), 0)
dealer_code = WorksheetFunction.Match("dealer_code", Rows("1:1"), 0)
Sh.Columns(Region_Name).Copy Destination:=DestSheet.Range("B" & Last + 1)
Sh.Columns(location_code).Copy Destination:=DestSheet.Range("C" & Last + 1)
Sh.Columns(location_name).Copy Destination:=DestSheet.Range("D" & Last + 1)
Sh.Columns(dealer_code).Copy Destination:=DestSheet.Range("E" & Last + 1)
End If
End If
`CopyRange.Copy`
With DestSheet.Cells(Last + 1, "B")
End With
DestSheet.Cells(Last + 1, "A").Resize(CopyRange.Rows.Count).Value = Sh.Name
`Next`
`ExitTheSub:`
Application.Goto DestSheet.Cells(1)
' AutoFit the column width in the summary sheet.
DestSheet.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
I am seeing another error in regards to my copy range function. I am wanting the vba to go sheet by and and only copy the data under the column headers that match what is in the master. Thanks for the help!!
Your error is in the fact that you do not refer to the Sheets
collection properly. It should be done like this:
Set DestSheet = Sheets("Database_Headers")
However, in this case, you should not refer to the Sheets
collection, but to the Worksheets
collection, because you have declared DestSheet
as a Worksheet
and thus you can avoid some problems later. Thus like this:
Set DestSheet = Worksheets("Database_Headers")
In general, this is the difference between a Worsheet
and a Sheet
(and the corresponding collections) - create an empty Excel and add a chart sheet as a separate Sheet. Then run the following code:
Public Sub TestMe()
Debug.Print Worksheets.Count
Debug.Print Sheets.Count
End Sub
It would give 3
and 4
- you have 3 Excel Worksheets and 4 Sheets (the chart sheet is a sheet).
Here is a problem, that would be avoided if you use it correctly - VBA Refer to worksheet vs chart sheet