Macro to copy and paste multiple sheets into a new workbook

F

Fiveshorter

New Member
Joined
Jul 14, 2017
Messages
18
Hi,

I was wondering if anyone can helop me build a macro for a report i do every day. I have a master file that has multiple sheets. Every day i copy and paste some of these sheets into a new workbook.
In my master file i am only concerned about 3 sheets, MasterF, Customer, Country. I copy and paste customer into a new sheet and country into a new sheet (i only copy and paste the data to keep file size down). For my masterF file there are multiple filters, the data is in a standard table with standard filters on it. I filter my column entitled "Complete" to just yes and filter country to just "UK" then copy and paste the data into a new sheet (copying the data to keep file size down). Then i go back into the masterF file and unfilter. Then i filter the "complete" column to just "NO", country column to USA and NAME column to all except NOT AVAILABLE.

Result :

MasterF (A)
[TABLE="width: 500"]
<tbody>[TR]
[TD]CustID[/TD]
[TD]Name[/TD]
[TD]Country[/TD]
[TD]Order ID[/TD]
[TD]Complete[/TD]
[TD]QTY[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Tim[/TD]
[TD]UK[/TD]
[TD]67[/TD]
[TD]YES[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Daenerys[/TD]
[TD]UK[/TD]
[TD]190[/TD]
[TD]YES[/TD]
[TD]6[/TD]
[/TR]
</tbody>[/TABLE]


MasterF (B)
[TABLE="width: 500"]
<tbody>[TR]
[TD]CustID[/TD]
[TD]Name[/TD]
[TD]Country[/TD]
[TD]Order ID[/TD]
[TD]Complete[/TD]
[TD]QTY[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Emma[/TD]
[TD]USA[/TD]
[TD]54[/TD]
[TD]NO[/TD]
[TD]3[/TD]
[/TR]
</tbody>[/TABLE]


Country
[TABLE="width: 500"]
<tbody>[TR]
[TD]Cust ID[/TD]
[TD]Country[/TD]
[/TR]
[TR]
[TD]123124[/TD]
[TD]USA[/TD]
[/TR]
[TR]
[TD]45353[/TD]
[TD]UK[/TD]
[/TR]
</tbody>[/TABLE]


Customer
[TABLE="width: 500"]
<tbody>[TR]
[TD][TABLE="width: 500"]
<tbody>[TR]
[TD]Cust ID[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]6543[/TD]
[TD]Damian[/TD]
[/TR]
[TR]
[TD]7645[/TD]
[TD]David[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Sheets in Master excel Sheet

Customer sheet
[TABLE="width: 500"]
<tbody>[TR]
[TD]Cust ID[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]6543[/TD]
[TD]Damian[/TD]
[/TR]
[TR]
[TD]7645[/TD]
[TD]David[/TD]
[/TR]
</tbody>[/TABLE]


Country sheet
[TABLE="width: 500"]
<tbody>[TR]
[TD]Cust ID[/TD]
[TD]Country[/TD]
[/TR]
[TR]
[TD]123124[/TD]
[TD]USA[/TD]
[/TR]
[TR]
[TD]45353[/TD]
[TD]UK[/TD]
[/TR]
</tbody>[/TABLE]

MasterF sheet
[TABLE="width: 500"]
<tbody>[TR]
[TD]CustID[/TD]
[TD]Name[/TD]
[TD]Country[/TD]
[TD]Order ID[/TD]
[TD]Complete[/TD]
[TD]QTY[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Jon[/TD]
[TD]USA[/TD]
[TD]34[/TD]
[TD]YES[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Emma[/TD]
[TD]USA[/TD]
[TD]54[/TD]
[TD]NO[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Tim[/TD]
[TD]UK[/TD]
[TD]67[/TD]
[TD]YES[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Sansa[/TD]
[TD]UK[/TD]
[TD]78[/TD]
[TD]NO[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Daenerys[/TD]
[TD]UK[/TD]
[TD]190[/TD]
[TD]YES[/TD]
[TD]6
[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
Trying to ensure I fully understand your request. For Result you show Master(A) and (B) to represent to values to copy after applying each filter. Are both sets being copied to 1 worksheet or separate worksheets in the new MasterF workbook?

Let me know. I'll be working on a solution for you.
 
Upvote 0
Hi,

In my workbook to be copied, my masterF sheet is filtered first in my Master excel sheet(set Complete to yes,Country to UK), copied and pasted into a new workbook in a new sheet entitled Master(A). Then my masterF file is unifiltered and then filtered again (set Complete to no,Country to USA,Name to all except NOT AVAILABLE), copied and pasted in the new workbook in a new sheet called Master(B). Under the heading results is basically what i would like to happen when the macro is run.
Resulting workbook will have my country sheet, customer sheet, MasterA (from my masterf sheet), MasterB (from my masterf sheet)
Hopefully thats a bit clear and thank you for the help!
 
Last edited:
Upvote 0
Alright, I believe this should do it for you. For now, this code does not save the newly created file. I can add that if necessary.

Code: 
Option Explicit
Sub CopyToWorkbooks()
Dim cfwb As Workbook
Dim ctwb As Workbook
Dim cfws As Worksheet
Dim ctws As Worksheet
Dim ws As Worksheet
Dim cfrng As Range
Dim ctrng As Range
Dim lastrow As Long
Dim ctlr As Long


Set cfwb = ThisWorkbook


'   Open New Workbook and add/name Worksheets
Workbooks.Add
Set ctwb = ActiveWorkbook


Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Master(A)"
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Master(B)"
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Customer"
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Country"
Application.DisplayAlerts = False
ctwb.Worksheets("Sheet1").Delete
Application.DisplayAlerts = True


'   Copy data from Customer Worksheet and Paste in new Workbook
Set cfws = cfwb.Sheets("Customer")
Set ctws = ctwb.Sheets("Customer")
With cfws
    .Range(.Cells(1, 1), .Cells(1, 2).End(xlDown)).Copy Destination:=ctws.Range("A1")
End With
Application.CutCopyMode = False


'   Copy data from Country Worksheet and Paste in new Workbook
Set cfws = ThisWorkbook.Sheets("Country")
Set ctws = ActiveWorkbook.Sheets("Country")
With cfws
    .Range(.Cells(1, 1), .Cells(1, 2).End(xlDown)).Copy Destination:=ctws.Range("A1")
End With
Application.CutCopyMode = False


'   Copy data from MasterF Worksheet for Complete = "YES" and Country = "UK"
    Set cfws = ThisWorkbook.Sheets("MasterF")
    Set ctws = ActiveWorkbook.Worksheets("Master(A)")
    lastrow = cfws.Cells(Rows.Count, "A").End(xlUp).Row
    Set ctrng = ctws.Range("A1")


'   Clear any existing Filters and apply new Filter
    cfws.AutoFilterMode = False
    Set cfrng = cfws.Range("A1:F" & lastrow)
    cfrng.AutoFilter
    cfrng.AutoFilter Field:=3, Criteria1:="UK"
    cfrng.AutoFilter Field:=5, Criteria1:="YES"
    cfrng.SpecialCells(xlCellTypeVisible).Copy Destination:=ctrng


'   Copy data from MasterF Worksheet for Complete = "NO" and Country = "USA"
    Set cfws = ThisWorkbook.Sheets("MasterF")
    Set ctws = ActiveWorkbook.Worksheets("Master(B)")
    Set ctrng = ctws.Range("A1")


'   Clear any existing Filters and apply new Filter
    cfws.AutoFilterMode = False
    Set cfrng = cfws.Range("A1:F" & lastrow)
    cfrng.AutoFilter
    cfrng.AutoFilter Field:=3, Criteria1:="USA"
    cfrng.AutoFilter Field:=5, Criteria1:="NO"
    cfrng.SpecialCells(xlCellTypeVisible).Copy Destination:=ctrng


    MsgBox ("All copying has been completed")


End Sub
 
Upvote 0
Hi Thank you for the solution. However i am having trouble with :
<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #008f00 ; background-color: #ffffff}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000 ; background-color: #ffffff}span.s1 {color: #011993}</style>' Clear any existing Filters and apply new Filter
cfws.AutoFilterMode = False
Set cfrng = cfws.Range("A1:F" & lastrow)
cfrng.AutoFilter
cfrng.AutoFilter Field:=3, Criteria1:="UK"
cfrng.AutoFilter Field:=5, Criteria1:="YES"
cfrng.SpecialCells(xlCellTypeVisible).Copy Destination:=ctrng

I get the below message at the line that says : cfrng.AutoFilter
"<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px 'Helvetica Neue'}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px 'Helvetica Neue'; min-height: 12.0px}</style>Run-time error '1004':
Method 'AutoFilter' of object 'Range' failed
"
The code still does something, it creates the workbook, makes 4 sheets and names them, customer and country is pasted correctly but the masterA and B are blank. And sheet1 is not deleted? Also just a question on the macro will this run regardless of how many records are in all the files as this changed every date ie country could have 6 records today and 20 tomorrow for example

I appreciate your time on helping me on this!
 
Upvote 0
Hi, It was on my end it works perfectly. however would it be possible to have to program copy and paste different ranges of data for country and customer ie country today has 10 tomorrow 20, Thanks1
 
Upvote 0
The code is written to be flexible concerning the number of rows to copy. For worksheets Country and Customer the following line of code determines the Range to be copied.
The portion of the middle line of code ".Cells(1, 2).End(xlDown))" ensures it will get any number of records.
A word of caution here and your response may lead me to modify my approach. My assumption is that there are no blank rows in these two Worksheets.
Let me know because if that could potentially happen I will change to the 'LastRow' approach to ensure I am copying all records.
LastRow is the approach I used for the MasterF Worksheet.

Code: 
With cfws
    .Range(.Cells(1, 1), .Cells(1, 2).End(xlDown)).Copy Destination:=ctws.Range("A1")
End With
 
Upvote 0
Okay, modified to ensure lastrow is selected for copy on Customer and Company worksheets

Code: 
Option Explicit
Sub CopyToWorkbooks()
Dim cfwb As Workbook
Dim ctwb As Workbook
Dim cfws As Worksheet
Dim ctws As Worksheet
Dim ws As Worksheet
Dim cfrng As Range
Dim ctrng As Range
Dim lastrow As Long
Dim ctlr As Long


Set cfwb = ThisWorkbook


'   Open New Workbook and add/name Worksheets
Workbooks.Add
Set ctwb = ActiveWorkbook


Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Master(A)"
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Master(B)"
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Customer"
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Country"
Application.DisplayAlerts = False
ctwb.Worksheets("Sheet1").Delete
Application.DisplayAlerts = True


'   Copy data from Customer Worksheet and Paste in new Workbook
Set cfws = cfwb.Sheets("Customer")
Set ctws = ctwb.Sheets("Customer")
lastrow = cfws.Cells(Rows.Count, "A").End(xlUp).Row
With cfws
    .Range(.Cells(1, 1), .Cells(lastrow, 2)).Copy Destination:=ctws.Range("A1")
End With
Application.CutCopyMode = False


'   Copy data from Country Worksheet and Paste in new Workbook
Set cfws = ThisWorkbook.Sheets("Country")
Set ctws = ctwb.Sheets("Country")
lastrow = cfws.Cells(Rows.Count, "A").End(xlUp).Row
With cfws
    .Range(.Cells(1, 1), .Cells(lastrow, 2)).Copy Destination:=ctws.Range("A1")
End With
Application.CutCopyMode = False


'   Copy data from MasterF Worksheet for Complete = "YES" and Country = "UK"
    Set cfws = ThisWorkbook.Sheets("MasterF")
    
'   Clear any existing Filters
    On Error Resume Next
    cfws.AutoFilterMode = False
    Set ctws = ctwb.Worksheets("Master(A)")
    lastrow = cfws.Cells(Rows.Count, "A").End(xlUp).Row
    Set ctrng = ctws.Range("A1")


'   Apply new Filter
    Set cfrng = cfws.Range("A1:F" & lastrow)
    cfrng.AutoFilter
    cfrng.AutoFilter Field:=3, Criteria1:="UK"
    cfrng.AutoFilter Field:=5, Criteria1:="YES"
    cfrng.SpecialCells(xlCellTypeVisible).Copy Destination:=ctrng


'   Copy data from MasterF Worksheet for Complete = "NO" and Country = "USA"
'    Set cfws = ThisWorkbook.Sheets("MasterF")
    Set ctws = ctwb.Worksheets("Master(B)")
    Set ctrng = ctws.Range("A1")


'   Clear any existing Filters and apply new Filter
    cfws.AutoFilterMode = False
    Set cfrng = cfws.Range("A1:F" & lastrow)
    cfrng.AutoFilter
    cfrng.AutoFilter Field:=3, Criteria1:="USA"
    cfrng.AutoFilter Field:=5, Criteria1:="NO"
    cfrng.SpecialCells(xlCellTypeVisible).Copy Destination:=ctrng


    MsgBox ("All copying has been completed")


End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
Excel VBA to filter by unique value, copy paste into new workbook and save
Replies
2
Views
821
rittersportyummy
R
H
  • Solved
How to copy data from one file and paste it into a dynamically named workbook
Replies
3
Views
627
dermie_72
D
G
  • Question Question
Workbook formulas copied with Sheet references in new Workbook
Replies
0
Views
399
GK039
G
R
  • Question Question
VBA to Copy Multiple sheets to new workbook & save as .xlsb or .xlsx
2
Replies
16
Views
2K
rahildhody
R
P
  • Question Question
multiple columns data copy and paste into different cell in other sheet
Replies
0
Views
382
pramod5542
P

Forum statistics

Threads
1,223,907
Messages
6,175,301
Members
452,633
Latest member
DougMo

Share this page

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