Coping data from one sheet to another - matching headers VBA

[spattar]

Hi,

Can you please helpme with VBA, I have an excel spreadsheet with 2 tabs (data, keyfigure matrix).

I extract data daily of another program on to the keyfigurematrix. And I need VBA code to copy this data over to data tab (withoutdeleting / overwriting previous days), matching the headers which are on toprow on both sheets. However the headers are not in same column every day on keyfigure matrix tab.


Thank you, your help will be much appreciated.

 

[spattar]

Hi,

Can you please helpme with VBA, I have an excel spreadsheet with 2 tabs (data, keyfigure matrix).

I extract data daily of another program on to the keyfigurematrix. And I need VBA code to copy this data over to data tab (withoutdeleting / overwriting previous days), matching the headers which are on toprow on both sheets. However the headers are not in same column every day on keyfigure matrix tab.


Thank you, your help will be much appreciated.

Hi, Please help me. Thanks in advance

 

[John_w]

Try this macro:

Public Sub Copy_keyfigure_matrix_To_data()

    Dim dataSheet As Worksheet, dataDestRow As Long
    Dim col As Long, lastRow As Long
    Dim foundCol As Variant
    
    Set dataSheet = ThisWorkbook.Worksheets("data")
    With dataSheet
        dataDestRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    
    With ThisWorkbook.Worksheets("keyfigure matrix")
        For col = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
            foundCol = Application.Match(.Cells(1, col).Value, dataSheet.Rows(1), 0)
            If Not IsError(foundCol) Then
                lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
                .Range(.Cells(2, col), .Cells(lastRow, col)).Copy dataSheet.Cells(dataDestRow, foundCol)
            Else
                MsgBox "Column heading '" & .Cells(1, col).Value & "' not found in data sheet"
            End If
        Next
    End With

End Sub

 

[spattar]

Hi John_w, thanks a lot for your help, this works great.