combine data with different header

Question

I have a multiple worksheets majority of have same header but one(1) worksheet has different header

I have this code that will combine them all

Sub combined()

Dim xWs As Worksheet
On Error Resume Next

Set xWs = ActiveWorkbook.Worksheets.Add(Sheets(1))
xWs.name = "Combined"
Worksheets(2).Range("A1").EntireRow.Copy Destination:=xWs.Range("A1")
For i = 2 To Worksheets.Count
    Worksheets(i).Range("A1").CurrentRegion.Offset(1, 0).Copy _
           Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row + 1, 1)

Next

Dim s As Worksheet, t As String
Dim j As Long, K As Long
K = Sheets.Count

For j = K To 1 Step -1
    t = Sheets(j).name
    If t <> "Combined" Then
        Application.DisplayAlerts = False
            Sheets(j).Delete
        Application.DisplayAlerts = True
    End If
Next j

End Sub

it works well but I want my 1 sheet to be inserted on column D to it's last column

sheet3 doesn't contains the first 3 columns of the other sheet example

sheet1, sheet2 and sheet 4 contains this columns

Branch | Population | Store | name | age | ...

while sheet3 contains

name | age | ...

the rest are the same only on the first 3 columns are not. I don't what am I going to add to the code to insert it on its designated column.

oh they contains different data values

thanks!

Answer 1

The easy, and not-so-dynamic way of doing it, would be to change the copy procedure for sheet3. By simply adding an if in the loop like so:

For i = 2 To Worksheets.Count
    If i <> 4 Then
        Worksheets(i).Range("A1").CurrentRegion.Offset(1, 0).Copy _
           Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row + 1, 1)
    Else
        Worksheets(i).Range("A1").CurrentRegion.Offset(1, 0).Copy _
           Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row + 1, 4)

    End If
Next i

This shifts the whole "paste" part 3 columns for sheet 3.

Depending on how columns could change for other sheets, you could count the columns and shift accordingly, even without using an if statement.

If columns are always missing from left to right, and Sheet1 is used as a base for how large the table is (as it is in this code), you could do something a bit more dynamic like this:

Dim xWs As Worksheet, i As Long, lCol As Long, mCol As Long

Set xWs = ActiveWorkbook.Worksheets.Add(Sheets(1))
xWs.Name = "Combined"
mCol = Worksheets(2).Cells(1, Columns.Count).End(xlToLeft).Column + 1
Worksheets(2).Range("A1").EntireRow.Copy Destination:=xWs.Range("A1")
For i = 2 To Worksheets.Count
        lCol = Worksheets(i).Cells(1, Columns.Count).End(xlToLeft).Column
        Worksheets(i).Range("A1").CurrentRegion.Offset(1, 0).Copy _
           Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row + 1, mCol - lCol)
Next i

Or something more advanced and comparing the name of each column.