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

ccastro4

New Member
Joined
Jun 14, 2022
Messages
18
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Just explain in a concise manner what you want to achieve.
The way I understand it is that you want to bring in all data from all sheets, except the "Master" sheet, into one sheet ("Master")
However, is that indeed all the data? Is it also all sheets or only some sheets? If not all sheets, which ones are excluded?
 
Upvote 0
Hi!

I have a master sheet (ADP Data) I need to populate with data for columns with same headers from 5 other sheets (RBD, ADX, FL4, QY2 and VRD).

The code I have now brings in data from one worksheet (VRD) into my ADP Data Sheet. I need the formula to do the same for the other 4 Sheets RBD, ADX, QY2 and FL4. I am not sure how to write this since I found the above formula online which helps me somewhat.

My target sheet is ADP Data and my Source Data Sheets should be RBD, ADX, FL4, QY2 and VRD

Hopefully this makes sense?
 

Attachments

  • Code.PNG
    Code.PNG
    44.2 KB · Views: 6
Upvote 0
Re: data for columns with same headers
Are there columns in sheets that do not need to be copied? In other words, do we have to find column headers in the sheets that correspond to headers in "Master" sheet because they are in a different order? If not, only certain columns?
Do you need to copy the whole column, excluding the header I assume, and paste it under the last used cell in the column with the same header in "Master"?
As I asked before, are there other sheets beside the ones you mention in the workbook. There is a difference when making a macro to work on all sheets except one or on 5 sheets with certain names. This depends on how you write the code.
 
Upvote 0
do we have to find column headers in the sheets that correspond to headers in "Master" sheet because they are in a different order? If not, only certain columns? - Yes - the columns are in different order in the sheets vs "Master" and some columns in the sheets are not needed to bring over to the Master sheet. Just the Columns listed out in the master

Do you need to copy the whole column, excluding the header I assume, and paste it under the last used cell in the column with the same header in "Master"? -
This is correct

All of the sheets that exists in the workbook and will not change the names are as follows
ADP Data (Master where we will consolidate data from subsequent sheets)
RBD
ADX
FL4
QY2
V6D
 
Upvote 0
Try this on a copy of your original.
Code:
Sub Maybe()
Dim wsArr, ws1 As Worksheet, i As Long, j As Long
wsArr = Array("RBD", "ADX", "FL4", "QY2", "V6D")
Set ws1 = Worksheets("ADP Data")
    For i = 1 To ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
        For j = LBound(wsArr) To UBound(wsArr)
            With Worksheets(wsArr(j))
                .UsedRange.Columns(.Rows(1).Find(ws1.Cells(1, i)).Column).Offset(1).Copy ws1.Cells(Rows.Count, i).End(xlUp).Offset(1)
            End With
        Next j
    Next i
End Sub
 
Upvote 0
thank you! I received an error message " Object Variable or with block variable not set"
 
Upvote 0
It works on a trial workbook here.
Did you need to change anything in the code from Post #6? If so, what needed a change?
Do all the sheets where you copy from have the column headers that are in the master?
Are these headers all in the top row?
Do they all have data in the columns
Do any names (column headers, sheet names) have an accidental leading or trailing space?
Add the On Error statements like so
Code:
With Worksheets(wsArr(j))
On Error Resume Next
.UsedRange.Columns(.Rows(1).Find(ws1.Cells(1, i)).Column).Offset(1).Copy ws1.Cells(Rows.Count, i).End(xlUp).Offset(1)
On Error GoTo 0
End With
If it works, you will miss the sheet where there is a discrepancy. (Header missing, wrongly named)
 
Upvote 0
I didn't change anything from post 6. I copied and pasted the code as is.

Do all the sheets where you copy from have the column headers that are in the master? (No - some headers do not exist in the master for data we do not need. Not all sheets have some of the column headers in the master
Are these headers all in the top row? Yes
Do they all have data in the columns Yes
Do any names (column headers, sheet names) have an accidental leading or trailing space? Doesnt appear so - I think the issue is stemming from not all of the master columns existing on all of the sheets. I say this because it appears the data populates on the master sheet but stops at a column that doesn't exist in all of the subsequent sheet
Add the On Error statements like so - How would i add this in the code you posted? Today is my first day looking at coding :) and bless your soul for your patience and willingness to help. I'd hug you if I could.
 
Upvote 0
You are right I think in suggesting that it is because of a missing header.

Delete the old code.

Use this instead
Code:
Sub Maybe()
Dim wsArr, ws1 As Worksheet, i As Long, j As Long
wsArr = Array("RBD", "ADX", "FL4", "QY2", "V6D")
Set ws1 = Worksheets("ADP Data")
    For i = 1 To ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
        For j = LBound(wsArr) To UBound(wsArr)
            With Worksheets(wsArr(j))
        On Error Resume Next
                    .UsedRange.Columns(.Rows(1).Find(ws1.Cells(1, i)).Column).Offset(1).Copy ws1.Cells(Rows.Count, i).End(xlUp).Offset(1)
        On Error GoTo 0
            End With
        Next j
    Next i
End Sub

Let us know what the outcome is please.

BTW, I appreciate your kindness in words but the hugs will have to wait!!!!!!
 
Upvote 0

Forum statistics

Threads
1,216,099
Messages
6,128,823
Members
449,470
Latest member
Subhash Chand

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top