damius314
08-22-2018, 03:53 PM
I am trying to create a spreadsheet with my first tab being the "master sheet" with a varying number of column headers only. There will also be additional sheets in the workbook that have matching column headers with data below it. I would like to be able to search all the other pages, matching columns with the master sheet and pasting the data below the column headers on the master sheet. The code below seemed like it would do the trick, however, after spinning my wheels for hours, I am not able to figure out the error. I attempted to upload a sample file as an xlsx and xlsm and both failed. Any suggestions on why it wouldn't upload?
Thanks for the help.
Here is the code originally posted by SamT
Option Explicit
Sub VBAX_SamT()
'Adjust 2 instances "MasterSheetName" to suit
'For each header in Master Sheet, searches all other sheets for matching header,
'Then copys all data below matching header to bottom of Used Master header column.
Dim rngMasterHeaders As Range
Dim Cel As Range
Dim Sht As Worksheet
Dim CopyHeader As Range
Dim Dest As Range
Set rngMasterHeaders = Sheets("PBT"). _
Range(Cells(1, "A"), Cells(1, Columns.Count).End(xlToLeft))
For Each Cel In rngMasterHeaders
If Cel.Value <> "" Then
For Each Sht In Worksheets
If Sht.Name <> "PBT" Then
Set CopyHeader = Sht.Range("1:1").Find(Cel.Value)
If Not CopyHeader Is Nothing Then
Set Dest = Cel.Parent.Range(Rows.Count, Cel.Column).End(xlUp).Offset(1)
Range(CopyHeader.Offset(1), Cells(Rows.Count, CopyHeader.Column).End(xlUp)).Copy Dest
Set CopyHeader = Nothing
End If
End If
Next Sht
End If
Next Cel
End Sub
Thanks for the help.
Here is the code originally posted by SamT
Option Explicit
Sub VBAX_SamT()
'Adjust 2 instances "MasterSheetName" to suit
'For each header in Master Sheet, searches all other sheets for matching header,
'Then copys all data below matching header to bottom of Used Master header column.
Dim rngMasterHeaders As Range
Dim Cel As Range
Dim Sht As Worksheet
Dim CopyHeader As Range
Dim Dest As Range
Set rngMasterHeaders = Sheets("PBT"). _
Range(Cells(1, "A"), Cells(1, Columns.Count).End(xlToLeft))
For Each Cel In rngMasterHeaders
If Cel.Value <> "" Then
For Each Sht In Worksheets
If Sht.Name <> "PBT" Then
Set CopyHeader = Sht.Range("1:1").Find(Cel.Value)
If Not CopyHeader Is Nothing Then
Set Dest = Cel.Parent.Range(Rows.Count, Cel.Column).End(xlUp).Offset(1)
Range(CopyHeader.Offset(1), Cells(Rows.Count, CopyHeader.Column).End(xlUp)).Copy Dest
Set CopyHeader = Nothing
End If
End If
Next Sht
End If
Next Cel
End Sub