Transfer multiple Sheets into one

Panoos64

Well-known Member
Joined
Mar 1, 2014
Messages
882
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
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Re: Transfer multible Sheets into one

How about
Code:
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
 
Upvote 0
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
 
Upvote 0
Re: Transfer multible Sheets into one

Glad to help & thanks for the feedback
 
Upvote 0
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
 
Upvote 0
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 ?
 
Upvote 0
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
 
Upvote 0
Re: Transfer multible Sheets into one

How about
Code:
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
 
Upvote 0
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!
 
Upvote 0
Re: Transfer multible Sheets into one

You're welcome & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,144
Members
448,552
Latest member
WORKINGWITHNOLEADER

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top