Need help setting up multiple sheets as source worksheets. Trying to loop through multiple sheets to consolidate data into a master sheet

[ccastro4]

Hi! I am new to VBA.

I currently have this code to help bring in data to a master sheet from another sheet with the same column header. Right now it only looks at one sheet (v6d). How do i get the code to look at the other 4 source worksheets to bring back the data into the master sheet? Code Below

Private Sub CommandButton1_Click()

Dim sourceWS As Worksheet, targetWS As Worksheet
Dim lastCol As Long, lastRow As Long, srcRow As Range
Dim found1 As Range, found2 As Range, j As Long, Cr1 As String


Set sourceWS = Worksheets("V6D")
Set targetWS = Worksheets("ADP Data")


With sourceWS
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For j = 1 To lastCol
Cr1 = .Cells(1, j).Value
Set srcRow = .Range("A1", .Cells(1, lastCol))
Set found1 = srcRow.Find(What:=Cr1, LookAt:=xlWhole, MatchCase:=False)

If Not found1 Is Nothing Then
lastCol = targetWS.Cells(1, Columns.Count).End(xlToLeft).Column
Set srcRow = targetWS.Range("A1", targetWS.Cells(1, lastCol))
Set found2 = srcRow.Find(What:=Cr1, LookAt:=xlWhole, MatchCase:=False)

If Not found2 Is Nothing Then
lastRow = .Cells(Rows.Count, found1.Column).End(xlUp).Row
.Range(.Cells(2, found1.Column), .Cells(lastRow, found1.Column)).Copy
found2.Offset(1, 0).PasteSpecial xlPasteAll
End If

End If

Next j

End With


End Sub

 

[jolivanes]

This might be better as it checks for the header.
It executes if the header is found.

Sub Maybe_2()
Dim sh1 As Worksheet, wsArr, i As Long, j As Long, cel As Range, lr As Long
Set sh1 = Worksheets("ADP Data")
wsArr = Array("RBD", "ADX", "FL4", "QY2", "V6D")
    For i = 1 To 4
        For j = LBound(wsArr) To UBound(wsArr)
            With Worksheets(wsArr(j))
                Set cel = .Rows(1).Find(sh1.Cells(1, i).Value)
                    If Not cel Is Nothing Then
                        lr = .Cells(.Rows.Count, cel.Column).End(xlUp).Row
                        .Cells(2, cel.Column).Resize(lr - 1).Copy sh1.Cells(sh1.Rows.Count, i).End(xlUp).Offset(1)
                    End If
            End With
        Next j
    Next i
End Sub

Delete the previous code, or cut and paste it somewhere if you want to keep it, and put above code in its place.

 

[ccastro4]

this seems to work!!!! Thank you so much. You just made my life so much easier

One more question - How would I link this code to a command button?

Again thank you so much!

 

[jolivanes]

Assign a macro to a Form or a Control button - Microsoft Support

Create a Form button or a Command button and assign a macro that performs an action when a user clicks the button.

support.microsoft.com

Use a Form Control Button. (See above Microsoft site)
When it is positioned on your sheet, right click on it and on the pop-up select "Assign Macro"
Click on the "Maybe" macro, or whatever you have renamed it, and select "OK".

Hope that it explained it sufficiently to get you going.

If not, let us know.

If you're interested in another solution that only uses values, without copy and paste, let us know also

Good Luck

 

[ccastro4]

All set. thank you!!!!

 

[ccastro4]

Hi - Im back

Im having a small hiccup in my macro.

Im going to try to explain this as thoroughly as possible.

This tab has a macro that pulls in the columns from the subsequent tabs and consolidates the data.

For the pay group tab RBD, Column HOL - Holiday Pay does not exist so this should be ignored and skipped. However, in ADX tab, the macro is filling in the data on row 2 versus row 8, shifting the data up in the summary. The cells in yellow should have started in row 8 as these figures below to the individuals in ADX pay group. Can you help me troubleshoot this? Rows 2-7(yellow highlight) should be blank or zero since this data doesnt exist.


below is the macro

Sub Maybe_2()
Dim sh1 As Worksheet, wsArr, i As Long, j As Long, cel As Range, lr As Long
Set sh1 = Worksheets("ADP Data")
wsArr = Array("RBD", "ADX", "FL4", "QY2", "V6D")
For i = 1 To 4
For j = LBound(wsArr) To UBound(wsArr)
With Worksheets(wsArr(j))
Set cel = .Rows(1).Find(sh1.Cells(1, i).Value)
If Not cel Is Nothing Then
lr = .Cells(.Rows.Count, cel.Column).End(xlUp).Row
.Cells(2, cel.Column).Resize(lr - 1).Copy sh1.Cells(sh1.Rows.Count, i).End(xlUp).Offset(1)
End If
End With
Next j
Next i

 

[jolivanes]

It makes it so much easier if you take the time to put your code between code tags

 

[ccastro4]

Sub Maybe_2()
Dim sh1 As Worksheet, wsArr, i As Long, j As Long, cel As Range, lr As Long
Set sh1 = Worksheets("ADP Data")
wsArr = Array("RBD", "ADX", "FL4", "QY2", "V6D")
For i = 1 To 4
For j = LBound(wsArr) To UBound(wsArr)
With Worksheets(wsArr(j))
Set cel = .Rows(1).Find(sh1.Cells(1, i).Value)
If Not cel Is Nothing Then
lr = .Cells(.Rows.Count, cel.Column).End(xlUp).Row
.Cells(2, cel.Column).Resize(lr - 1).Copy sh1.Cells(sh1.Rows.Count, i).End(xlUp).Offset(1)
End If
End With
Next j
Next i

 

[ccastro4]

does that help?

 

[jolivanes]

Re: "For the pay group tab RBD, Column HOL - Holiday Pay does not exist so this should be ignored and skipped."
Is the above not happening in your code?

The macro pastes into the first empty cell (Cells(sh1.Rows.Count, i).End(xlUp).Offset(1)).
If there is a reason why that needs to be different, let us know why and what the restrictions are.

Re: "as these figures below to the individuals in ADX pay group"
Don't know what the above means. Please explain

 

[ccastro4]

The macro pastes into the first empty cell (Cells(sh1.Rows.Count, i).End(xlUp).Offset(1)).
If there is a reason why that needs to be different, let us know why and what the restrictions are. - Yes, we need the data being pulled in to match the corresponding rows from the other columns brought in from that data sheet. Does that make sense? Since some sheets do no include certain columns, it should remain blank.

Re: "For the pay group tab RBD, Column HOL - Holiday Pay does not exist so this should be ignored and skipped."
Is the above not happening in your code? - if I ran the macro for this sheet only (data only living on this sheet), it works. But if i run the macro for all the sheets (data living on all sheets), this column gets filled with data from the next sheet since its the first blank row. we dont want this to happen since this misaligns the data.