VBA Copy New Sheet & Existing

creepinjorge

New Member
Joined
Dec 17, 2014
Messages
8
Hi,

I'm creating new files (over 40) based on a list. Column M On "Lookup" contains the list and new file names.

Ideally the new file contains 1) A copied tab "Account_Risk_Assessment" 2) the original "Lookup" tab

I've pieced together this from other forums...

Sub accountlisting()
Sheets("Lookup").Select
'create account list
Dim lr As Integer
lr = Range("A" & Rows.Count).End(xlUp).Row
Columns("A:A").Select
Range("A1:A" & lr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("M1" _
), Unique:=True

'create sheet for each account in list
Dim lrvaccounts As Integer
Dim c As Range
lraccounts = Range("M" & Rows.Count).End(xlUp).Row
Range("M2:M" & lraccounts).Name = "accounts"
For Each c In Range("accounts")
Sheets.Add
ActiveSheet.Name = c.Value
Next c
'copy Master sheet into each account sheet
For Each c In Range("accounts")
Sheets("Account_Risk_Assessment").Cells.Copy Destination:=Sheets(c.Value).Range("A1")
Next c
'saves each sheet as it's own file under worksheet name
Dim ws As Worksheet

Excluded = Array("Account_Risk_Assessment", "Info")
Set MyBook = ActiveWorkbook
Application.DisplayAlerts = False
For Each ws In Sheets
x = Application.Match(ws.Name, Excluded, 0)

If ws.Range("G5").Value <> "" And IsError(x) Then
MyFile = ws.Name
MyPath = "Enter New Path"
ws.Copy

ActiveWorkbook.SaveAs MyPath & MyFile
ActiveWorkbook.Close
MyBook.Activate
End If
Next ws
End Sub



My issue is ws.Copy only copies the newly created sheet and I'd like the new files to include the sheet (as it's working now) AND the original "Lookup" sheet.

Sheets(Array("ws","Lookup")).Copy is my idea that's not working.

Thank you!

 
Does this work?
Code:
Sheets(Array(ws.Name,"Lookup")).Copy
 
Upvote 0
Love it. Great stuff...does create the new file with both sheets included. I'm stopped on
ActiveWorkbook.SaveAs MyPath & MyFile though. Any ideas?
 
Upvote 0
'Stopped' how?

Have you checked the values of MyPath and MyFile when it happens?
 
Upvote 0
Solved! Along the way my 'Account' folder changed names (user error). Just ran with no errors. Kudos to you! Two thumbs up!
 
Upvote 0

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