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