Transfer multiple Sheets into one

[Panoos64]

Hi all, i would like to create a VBA code so that to run through a workbook and should transfer all Sheets' data (Sheet1, Sheet2 e.t.c.) into new one named "Summary". The data of each Sheet, should be placed into new, below each other.
Therefore that the Sheets are not stably and maybe will be just 2, but no more than 100. The new Sheet "Summary" should be placed first on the left side.

Thanks to all in advance

 

[Fluff]

Re: Transfer multible Sheets into one

How about

Sub MergeShts()
   Dim Ws As Worksheet
   Dim Sws As Worksheet
   
   Sheets.Add(Sheets(1)).name = "Summary"
   Set Sws = ActiveSheet
   For Each Ws In Worksheets
      If Not Ws.name = "Summary" Then
         Ws.UsedRange.Copy Sws.Range("A" & Rows.Count).End(xlUp).Offset(1)
      End If
   Next Ws
End Sub

 

[Panoos64]

Re: Transfer multible Sheets into one

Thank you Fluff, it works perfect. Thanks also for your time spent for my project. Hv a great lovely day

 

[Fluff]

Re: Transfer multible Sheets into one

Glad to help & thanks for the feedback

 

[Panoos64]

Re: Transfer multible Sheets into one

Hi Fluff, Can you modify the above code and therefore that, the sheet "Summary" already exists. I would like to use the above code with such case in a another project. Thank u in advance

 

[Michael M]

Re: Transfer multible Sheets into one

I don't follow.....do you mean the same code with a differnt sheet name ??
OR
check to see if "Summary" exists?
OR
Don't add the "Summary" sheet ?

 

[Panoos64]

Re: Transfer multible Sheets into one

Do not worry Michael, i appreciate your intention to help me. Is the second, don't add "Summary" sheet which is already exists

 

[Fluff]

Re: Transfer multible Sheets into one

How about

Sub MergeShts()
   Dim Ws As Worksheet
   Dim Sws As Worksheet
   
   If Not Evaluate("isref(Summary!A1)") Then
      Sheets.Add(Sheets(1)).Name = "Summary"
   End If
   Set Sws = Sheets("Summary")
   For Each Ws In Worksheets
      If Not Ws.Name = "Summary" Then
         Ws.UsedRange.Copy Sws.Range("A" & Rows.Count).End(xlUp).Offset(1)
      End If
   Next Ws
End Sub

 

[Panoos64]

Re: Transfer multible Sheets into one

Well done Fluff! is perfect. It works nicely and based to my data. I appreciate you continued support to me, by which i create many reports and i overcome my tasks in an easy way. Thank u so much. Hv a great day!

 

[Fluff]

Re: Transfer multible Sheets into one

You're welcome & thanks for the feedback