This seemed easy when I started but am have trouble now.
I am trying to take one file and do the following steps:
1. Create new folder based on a few cells in the file
2. "save as" the file to the newly created folder
3. Copy paste values the newly created file on all tabs
4. Take newly created value file and break it up again into smaller files with just a few particular tabs (savng them in same folder)
5. Email smaller files to individuals based on an independent excel file.
Currently stuck on #3. It is only paste valueing one sheet instead of all of them. I've used this same block of code in another file but never in something I've just "saved as". Am I not coding it to the newly created file? is that the issue? and if so how do I do that?
Sub PASTE_VALUES()
'Macro designed 1/27/2015
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Step 1 - CREATE NEW FOLDER TO SAVE HARDCODED FILES
Dim mainpath, subfolder1, subfolder2, subfolder3, strPathname As String
On Error Resume Next ' If directory exist goto next line
mainpath = Worksheets("Email Cover").Range("C44").Value ' Default path name
subfolder1 = Worksheets("Email Cover").Range("C45").Value ' stores value of C45 cell for Year
subfolder2 = Worksheets("Email Cover").Range("C46").Value ' stores value of C46 cell for Month
subfolder3 = Worksheets("Email Cover").Range("C47").Value ' stores value of C47 cell for Day
If IsEmpty(mainpath) Then Exit Sub
MkDir mainpath & subfolder1 ' creates subfolder1 (Year)
strPathname = mainpath & "\" & subfolder1
If IsEmpty(subfolder2) Then Exit Sub
MkDir strPathname & "\" & subfolder2 ' ceate subfolder (Month)
strPathname = mainpath & "\" & subfolder1 & "\" & subfolder2
If IsEmpty(subfolder3) Then Exit Sub
MkDir strPathname & "\" & subfolder3 ' ceate subsubfolder (Day)
strPathname = mainpath & "\" & subfolder1 & "\" & subfolder2 & "\" & subfolder3
'Step 2 - SAVE FILE TO NEWLY CREATED FOLDER
ThisWorkbook.SaveAs Filename:=Worksheets("Email Cover").Range("C48").Value ' Reference for file name
'Step 3 - PASTE VALUES FOR ALL SHEETS
For Each Worksheet In ThisWorkbook
With Worksheet
.Range("A1:XFD1048576").Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
Next Worksheet
Application.Goto Worksheets("Email Cover").Range("C7")
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Bookmarks