Skip to main content
AI Assist is now on Stack Overflow. Start a chat to get instant answers from across the network. Sign up to save and share your chats.
added 43 characters in body
Source Link
TinMan
  • 7.8k
  • 2
  • 13
  • 24

What I did was make a function that would find the column header and return the data range from from that column.

Sub master_sheet_data() Application.ScreenUpdating = False Dim ws As Worksheet Dim cell As Range, source As Range, target As Range With ThisWorkbook.Worksheets("Raw RHI data - direct referrals") For Each ws In Worksheets(Array("Refined event data - all", "Refined event data", "Refined MASH data")) For Each cell In .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)) Set source = getColumnDataBodyRange(ws, cell.Value) If Not source Is Nothing Then Set target = cell.Offset(.Rows.Count - 1).End(xlUp).Offset(1) source.Copy target.PasteSpecial xlPasteValuesAndNumberFormats End If Next Next End With Application.CutCopyMode = False  Application.ScreenUpdating = True End Sub Function getColumnDataBodyRange(ws As Worksheet, ColumnHeader As Variant) As Range Dim cell As Range With ws Set cell = .Rows(1).Find(What:=ColumnHeader, After:=.Range("A1")) If Not cell Is Nothing Then Set getColumnDataBodyRange = .Range(cell.Offset(1), cell.Offset(.Rows.Count - 1).End(xlUp)) End If End With End Function 

What I did was make a function that would find the column header and return the data range from from that column.

Sub master_sheet_data() Application.ScreenUpdating = False Dim ws As Worksheet Dim cell As Range, source As Range, target As Range With ThisWorkbook.Worksheets("Raw RHI data - direct referrals") For Each ws In Worksheets(Array("Refined event data - all", "Refined event data", "Refined MASH data")) For Each cell In .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)) Set source = getColumnDataBodyRange(ws, cell.Value) If Not source Is Nothing Then Set target = cell.Offset(.Rows.Count - 1).End(xlUp).Offset(1) source.Copy target.PasteSpecial xlPasteValuesAndNumberFormats End If Next Next End With Application.CutCopyMode = False End Sub Function getColumnDataBodyRange(ws As Worksheet, ColumnHeader As Variant) As Range Dim cell As Range With ws Set cell = .Rows(1).Find(What:=ColumnHeader, After:=.Range("A1")) If Not cell Is Nothing Then Set getColumnDataBodyRange = .Range(cell.Offset(1), cell.Offset(.Rows.Count - 1).End(xlUp)) End If End With End Function 

What I did was make a function that would find the column header and return the data range from from that column.

Sub master_sheet_data() Application.ScreenUpdating = False Dim ws As Worksheet Dim cell As Range, source As Range, target As Range With ThisWorkbook.Worksheets("Raw RHI data - direct referrals") For Each ws In Worksheets(Array("Refined event data - all", "Refined event data", "Refined MASH data")) For Each cell In .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)) Set source = getColumnDataBodyRange(ws, cell.Value) If Not source Is Nothing Then Set target = cell.Offset(.Rows.Count - 1).End(xlUp).Offset(1) source.Copy target.PasteSpecial xlPasteValuesAndNumberFormats End If Next Next End With Application.CutCopyMode = False  Application.ScreenUpdating = True End Sub Function getColumnDataBodyRange(ws As Worksheet, ColumnHeader As Variant) As Range Dim cell As Range With ws Set cell = .Rows(1).Find(What:=ColumnHeader, After:=.Range("A1")) If Not cell Is Nothing Then Set getColumnDataBodyRange = .Range(cell.Offset(1), cell.Offset(.Rows.Count - 1).End(xlUp)) End If End With End Function 
Source Link
TinMan
  • 7.8k
  • 2
  • 13
  • 24

What I did was make a function that would find the column header and return the data range from from that column.

Sub master_sheet_data() Application.ScreenUpdating = False Dim ws As Worksheet Dim cell As Range, source As Range, target As Range With ThisWorkbook.Worksheets("Raw RHI data - direct referrals") For Each ws In Worksheets(Array("Refined event data - all", "Refined event data", "Refined MASH data")) For Each cell In .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)) Set source = getColumnDataBodyRange(ws, cell.Value) If Not source Is Nothing Then Set target = cell.Offset(.Rows.Count - 1).End(xlUp).Offset(1) source.Copy target.PasteSpecial xlPasteValuesAndNumberFormats End If Next Next End With Application.CutCopyMode = False End Sub Function getColumnDataBodyRange(ws As Worksheet, ColumnHeader As Variant) As Range Dim cell As Range With ws Set cell = .Rows(1).Find(What:=ColumnHeader, After:=.Range("A1")) If Not cell Is Nothing Then Set getColumnDataBodyRange = .Range(cell.Offset(1), cell.Offset(.Rows.Count - 1).End(xlUp)) End If End With End Function