Tuesday, March 14, 2017

microsoft excel - combine data with different header


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



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.


No comments:

Post a Comment

hard drive - Leaving bad sectors in unformatted partition?

Laptop was acting really weird, and copy and seek times were really slow, so I decided to scan the hard drive surface. I have a couple hundr...