copy several sheets into one main sheet

[zeekmcphee]

Hello,
I have 6 sheets(sheets 1 to 6) full of data.The data rows will vary in length from a few rows to several hundred.Once the data has been collected in these sheets I copy and paste them all into one sheet,(sheet7)with the data from sheet one at the top,the data from sheet two directly underneath and so on.
I tried using a macro but of course the varying lengths of each sheet means that an ordinary macro wont work because data will be overidden,or their could be a gap in the data.
Is there a way to get automate this without copy and pasting,perhaps by using some vba code.
Ragards
Zeek

 

[GirishDhruva]

Hi Check with this code.
I have considered A1 as Header in each sheet

Option Explicit


Sub zeekmcphee()
Dim ws1, ws2, ws3, ws4, ws5, ws6, ws7 As Worksheet
Dim lr1, lr2, lr3, lr4, lr5, lr6, lr7 As Integer
Dim ColumnLetter1, ColumnLetter2, ColumnLetter3, ColumnLetter4, ColumnLetter5, ColumnLetter6 As Variant


Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
Set ws4 = Sheets("Sheet4")
Set ws5 = Sheets("Sheet5")
Set ws6 = Sheets("Sheet6")
Set ws7 = Sheets("Sheet7")


lr1 = ws1.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
lr2 = ws2.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
lr3 = ws3.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
lr4 = ws4.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
lr5 = ws5.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
lr6 = ws6.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
lr7 = ws7.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row


ColumnLetter1 = Split(ws1.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Cells.Address(1, 0), "$")(0)
ColumnLetter2 = Split(ws2.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Cells.Address(1, 0), "$")(0)
ColumnLetter3 = Split(ws3.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Cells.Address(1, 0), "$")(0)
ColumnLetter4 = Split(ws4.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Cells.Address(1, 0), "$")(0)
ColumnLetter5 = Split(ws5.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Cells.Address(1, 0), "$")(0)
ColumnLetter6 = Split(ws6.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Cells.Address(1, 0), "$")(0)


With ws7
    ws1.Range("A2:" & ColumnLetter1 & lr1).Copy ws7.Range("A" & lr7 + 1)
    lr7 = ws7.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
    ws2.Range("A2:" & ColumnLetter2 & lr2).Copy ws7.Range("A" & lr7 + 1)
    lr7 = ws7.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
    ws3.Range("A2:" & ColumnLetter3 & lr3).Copy ws7.Range("A" & lr7 + 1)
    lr7 = ws7.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
    ws4.Range("A2:" & ColumnLetter4 & lr4).Copy ws7.Range("A" & lr7 + 1)
    lr7 = ws7.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
    ws5.Range("A2:" & ColumnLetter5 & lr5).Copy ws7.Range("A" & lr7 + 1)
    lr7 = ws7.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
    ws6.Range("A2:" & ColumnLetter6 & lr6).Copy ws7.Range("A" & lr7 + 1)
End With
End Sub

 

[Fluff]

Another option

Sub zeekmcphee()
   Dim Ws As Worksheet
   
   With Sheets("Sheet7")
      For Each Ws In Worksheets
         If Ws.Name <> .Name Then
            Ws.UsedRange.Offset(1).Copy .Range("A" & Rows.Count).End(xlUp).Offset(1)
         End If
      Next Ws
   End With
End Sub

 

[GirishDhruva]

Hi @Fluff if data varies other than A column then it would be over written

 

[Fluff]

Agreed, but that can be changed very easily if needed. The OP didn't give us much to work with.

 

[zeekmcphee]

Hi fluff
Thanks for the reply.The code works up to a point.First it misses the first row from each sheet,and misses out sheet 6 altogether.I have tried tweeking a bit but to no avail.Any suggestions much appreciated
zeek

 

[zeekmcphee]

Hi GirishDhruva
Many thanks for the reply,when I run it I keep getting the following message
"run time error 91
Object variable or With block not set

when I debug it highlights this piece of the code.....

lr7 = ws7.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
Any suggestions much appreciated.
zeek

 

[Fluff]

How about

Sub zeekmcphee()
   Dim Ws As Worksheet
   
   With Sheets("[COLOR=#ff0000]Sheet7[/COLOR]")
      For Each Ws In Worksheets
         If Ws.Name <> .Name Then
            Ws.UsedRange.Copy .Range("A" & Rows.Count).End(xlUp).Offset(1)
         End If
      Next Ws
   End With
End Sub

And change the value in red to match the output sheet name

 

[zeekmcphee]

Hi Fluff,
Getting there bit by bit ,everything is working great now apart from the fact that it is only doing sheets 1 to 5 and ignoring sheet 6.Any suggestions most welcome
Regards
zeek

 

[Fluff]

Possibly a stupid question, but is there anything on sheet6?