vbaexcelruntime-errorcopy-paste

How to copy multiple sheets to a master sheet using distinct column headers


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!!


Solution

  • 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