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!
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!