VBA to copy data from multiple Sheets into One

[crusaderAG07]

Did a search in the forums and only found older threads that had already been answered but looking for help regarding combining data from multiple sheets into one for an upload process.

Background on my workbook. Each worksheet is exactly the same except for the department and the data. I've included the VBA that I set up for one sheet.

The first 4 lines of code are what I want to happen for every sheet and then pasted on the Master sheet in the next available cell of Data in column A. The rest of the data is just "formatting" code that can be ignored for the purpose of this question.

Sub Upload()
Sheets("9208 Administration").Range("A10:B444").Copy
Sheets("Master").Range("A1").PasteSpecial Paste:=xlPasteValues
Sheets("9208 Administration").Range("U10:AF442").Copy
Sheets("Master").Range("C1").PasteSpecial Paste:=xlPasteValues
Dim lRow As Long
Dim iCntr As Long
lRow = 435
For iCntr = lRow To 1 Step -1
If Trim(Cells(iCntr, 1)) = "" Then
Rows(iCntr).Delete
End If
Next
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Sheets("9208 Administration").Range("C9:C9").Copy
Sheets("Master").Range("A1:A" & Cells(Rows.Count, "B").End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Range("D1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Global_Status"
Range("D1").Copy
Sheets("Master").Range("D1:D" & Cells(Rows.Count, "C").End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Range("E1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Global_Class"
Range("E1").Copy
Sheets("Master").Range("E1:E" & Cells(Rows.Count, "D").End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
Columns("A:Q").Select
Columns("A:Q").EntireColumn.AutoFit
End Sub

 

[aRandomHelper]

Hi, welcome to the forums!

Unfortunately, it is slightly more complicated than you initially imagined, when it comes to repeating codes for every sheet. Your "formatting" codes were also only doing it based a single sheet's info, hence they must all be amended.

Please test this amended code (revamped, rather) on a copy of your workbook, in case anything goes wrong.

Sub Upload()
    Dim lRow As Long, wsLr As Long, pRow As Long
    Dim iCntr As Long
    Dim ws As Worksheet
   
    With ActiveWorkbook
        For Each ws In .Sheets 'loops through every worksheet
            If ws.Name <> "Master" Then 'if worksheet's name is NOT Master, then do the following
                With .Sheets("Master")
                    wsLr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
                    pRow = .Cells(.Cells.Rows.Count, "B").End(xlUp).Row + 1
                    If pRow = 2 Then pRow = 1
                    ws.Range("A10:B" & wsLr).Copy
                    .Cells(pRow, "B").PasteSpecial Paste:=xlPasteValues 'paste to col B instead
                    ws.Range("U10:AF" & wsLr).Copy
                    .Cells(pRow, "D").PasteSpecial Paste:=xlPasteValues 'paste to col D instead
                    .Range(.Cells(pRow, "A"), .Cells(.Cells(.Cells.Rows.Count, "B").End(xlUp).Row, "A")).Value = ws.Range("C9").Value
                End With
            End If
        Next
       
        With .Sheets("Master")
            lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
            For iCntr = lRow To 1 Step -1
                If Trim(.Cells(iCntr, "B").Text) = "" Then
                    .Rows(iCntr).Delete
                End If
            Next
           
            .Columns("D:D").Insert Shift:=xlToRight
            .Range("D1:D" & lRow).Value = "Global_Status"
           
            .Columns("E:E").Insert Shift:=xlToRight
            .Range("E1:E" & lRow).Value = "Global_Class"
           
            .Columns("A:Q").EntireColumn.AutoFit
        End With
    End With
End Sub

 

[crusaderAG07]

Hi, welcome to the forums!

Unfortunately, it is slightly more complicated than you initially imagined, when it comes to repeating codes for every sheet. Your "formatting" codes were also only doing it based a single sheet's info, hence they must all be amended.

Please test this amended code (revamped, rather) on a copy of your workbook, in case anything goes wrong.

Sub Upload()
    Dim lRow As Long, wsLr As Long, pRow As Long
    Dim iCntr As Long
    Dim ws As Worksheet
  
    With ActiveWorkbook
        For Each ws In .Sheets 'loops through every worksheet
            If ws.Name <> "Master" Then 'if worksheet's name is NOT Master, then do the following
                With .Sheets("Master")
                    wsLr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
                    pRow = .Cells(.Cells.Rows.Count, "B").End(xlUp).Row + 1
                    If pRow = 2 Then pRow = 1
                    ws.Range("A10:B" & wsLr).Copy
                    .Cells(pRow, "B").PasteSpecial Paste:=xlPasteValues 'paste to col B instead
                    ws.Range("U10:AF" & wsLr).Copy
                    .Cells(pRow, "D").PasteSpecial Paste:=xlPasteValues 'paste to col D instead
                    .Range(.Cells(pRow, "A"), .Cells(.Cells(.Cells.Rows.Count, "B").End(xlUp).Row, "A")).Value = ws.Range("C9").Value
                End With
            End If
        Next
      
        With .Sheets("Master")
            lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
            For iCntr = lRow To 1 Step -1
                If Trim(.Cells(iCntr, "B").Text) = "" Then
                    .Rows(iCntr).Delete
                End If
            Next
          
            .Columns("D:D").Insert Shift:=xlToRight
            .Range("D1:D" & lRow).Value = "Global_Status"
          
            .Columns("E:E").Insert Shift:=xlToRight
            .Range("E1:E" & lRow).Value = "Global_Class"
          
            .Columns("A:Q").EntireColumn.AutoFit
        End With
    End With
End Sub

I knew that my initial code was just for a specific sheet but this code worked to perfection the very first time! Thank you so much!!!

If I could ask one more bit of help. What would the code look like if I wanted to exclude copying certain sheets over to the master sheet. This code will be used in a budget workbook and there will be tabs with budget guidance and misc info that I don't want incorporated into the Master tab which will be my upload tab.

 

[aRandomHelper]

What would the code look like if I wanted to exclude copying certain sheets over to the master sheet.

Hi, to achieve this, you just have to include the sheet names in this If statement:

            If ws.Name <> "Master" and ws.Name <> "Exclude-Sheet-Name1(budget guidance?)" and ws.Name <> "Exclude-Sheet-Name2(misc info?)" Then 'if worksheet's name is NOT Master, then do the following