Copy data from one sheet to another based on column headers

[Raaverok]

Hi all,

So I read some topics on Google to solve this issue, but couldn't got it working.
Also I am still quite new with VBA and only know the basics, but eager to learn more about VBA.

My case is as follows:
We are making exports with around 250 columns of data, some of the columns are populated and others are not.
Now I found that not all export has 250 columns, some have more and some have less columns.
I want to setup 1 base sheet with all the columns and want to copy the details from the other sheets into that column.
It might be that there are columns where not all rows are populated, in this case I still want it to copy all the data.

The setup of the sheet will be:
- Name: "MainSheet" -> Here will be all the column headers and the data needs to be copied here.
- Name: "WeekA" -> Details of the first week of the month, these will be copied to MainSheet.
- Name: "WeekB" -> Details of the second week of the month, these will be copied to MainSheet.
- Name: "WeekC" -> Details of the thirds week of the month, these will be copied to MainSheet.
- Name: "WeekD" -> Details of the last week of the month, these will be copied to MainSheet.

Is there any code that can solve this issue?

Thanks in advance!

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, lCol As Long, ws As Worksheet
    Set desWS = ThisWorkbook.Sheets("MainSheet")
    Dim LastRow As Long, v As Variant, i As Long, header As Range
    For Each ws In Sheets
        If ws.Name <> "MainSheet" Then
            With ws
                lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
                LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                v = .Range("A1").Resize(, lCol).Value
                For i = LBound(v) To UBound(v, 2)
                    Set header = desWS.Rows(1).Find(v(1, i), LookIn:=xlValues, lookat:=xlWhole)
                    If Not header Is Nothing Then
                        .Range(.Cells(2, i), .Cells(LastRow, i)).Copy desWS.Cells(desWS.Rows.Count, header.Column).End(xlUp).Offset(1, 0)
                    End If
                Next i
            End With
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

 

[Raaverok]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, lCol As Long, ws As Worksheet
    Set desWS = ThisWorkbook.Sheets("MainSheet")
    Dim LastRow As Long, v As Variant, i As Long, header As Range
    For Each ws In Sheets
        If ws.Name <> "MainSheet" Then
            With ws
                lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
                LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                v = .Range("A1").Resize(, lCol).Value
                For i = LBound(v) To UBound(v, 2)
                    Set header = desWS.Rows(1).Find(v(1, i), LookIn:=xlValues, lookat:=xlWhole)
                    If Not header Is Nothing Then
                        .Range(.Cells(2, i), .Cells(LastRow, i)).Copy desWS.Cells(desWS.Rows.Count, header.Column).End(xlUp).Offset(1, 0)
                    End If
                Next i
            End With
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

Thank you very much!
This indeed fixed my issue

Just for my understanding and getting better in VBA:
In the Mainsheet you just look at the headers and in the other sheets you look for the identical headers.
After the headers are matched then you just copy all the data in this column and paste it inside the mainsheet, correct?

Thanks a lot!

 

[mumps]

You are very welcome and yes, you are correct.