copy single worksheet from a workbook to folder

P

paulsolar

Well-known Member
Joined
Aug 21, 2013
Messages
682
Office Version
  1. 365
Hi All

I have a workbook that I need to copy one sheet from to a folder I'm creating as part of the process.

I'm not having problems with the folder creation, just copying the sheet to the correct folder

What I am trying to do is put sheet 1 into "1 PHJ Daybook"

Sheet 1 is "Daybook Import Sheet"

I'm obviously going wrong at the end, I've been going around in circles with this for hours now, any ideas where I am going wrong??

Kind regards

Paul

VBA Code: 
Sub make_folders()
Application.ScreenUpdating = False
Dim myPackFolder As String
Dim myFolder As String
Dim Mycustomer As String
Dim myFolders()
Dim myIndex As Integer
Dim myfilepath As String
ReDim myFolders(99)
myFolders(0) = "1 PHJ Daybook"
myFolders(1) = "2 PPS System Import File"
myFolders(2) = "3 Engineers Route Planners"
myFolders(3) = "4 PPS Web App Day Report"
myFolders(4) = "5 Additional Information"
myfilepath = ThisWorkbook.Path
myFolder = myfilepath & "\Daily Reports\"
Mycustomer = VBA.Format(VBA.Now, "dd-MMM-yyyy")
myPackFolder = myFolder & "\" & Mycustomer & " Excel Files"


'check if folders already exist
If Dir(myPackFolder, vbDirectory) = "" Then
MkDir myPackFolder
Else
MsgBox "This date alread exists." & vbCr & vbCr & "Please check and try again.", vbExclamation, "Folder Error"
Exit Sub
End If


For myIndex = 0 To UBound(myFolders)
If myFolders(myIndex) = "" Then
Exit For
End If
MkDir myPackFolder & "\" & Mycustomer & "-" & myFolders(myIndex)
Next myIndex


''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sheet1.Activate


Worksheets("This Sheet").SaveAs ThisWorkbook.Path & "\Daily Reports\" & VBA.Format(VBA.Now, "dd-MMM-yyyy") & _
" Excel Files" & "\" & VBA.Format(VBA.Now, "dd-MMM-yyyy") & "-1 PHJ Daybook" & "\Daybook Import Sheet.xlsm"


MsgBox ("The record folders and PPS Import File have been created for: ") & Mycustomer, vbInformation + vbOKOnly, "Folder Created"




End Sub
 
Sort by date Sort by votes
Hi Fluff

I have tried everything but still no luck

Below are a few of the combinations I have tried.

i keep getting error 9 :oops:

I've lost the will to live, bit like watching Wales play at the moment.

I'll have another look tomorrow, I've gone cross eyed looking

Cheers

Paul


VBA Code: 
Sub make_folders()

Dim myPackFolder As String
    Dim myFolder As String
    Dim Mycustomer As String
    Dim myFolders()
    Dim myIndex As Integer
    Dim myfilepath As String
 
    Application.ScreenUpdating = False
    ReDim myFolders(99)
    myFolders(0) = "1 PHJ Daybook"
    myFolders(1) = "2 PPS System Import File"
    myFolders(2) = "3 Engineers Route Planners"
    myFolders(3) = "4 PPS Web App Day Report"
    myFolders(4) = "5 Additional Information"
    myfilepath = ThisWorkbook.Path
    myFolder = myfilepath & "\Daily Reports\"
    Mycustomer = VBA.Format(VBA.Now, "dd-MMM-yyyy")
    myPackFolder = myFolder & "\" & Mycustomer & " Excel Files"
    'check if folders already exist
    If Dir(myPackFolder, vbDirectory) = "" Then
         MkDir myPackFolder
    Else
         MsgBox "This date alread exists." & vbCr & vbCr & "Please check and try again.", vbExclamation, "Folder Error"
         Exit Sub
    End If
    For myIndex = 0 To UBound(myFolders)
    If myFolders(myIndex) = "" Then
         Exit For
    End If
    MkDir myPackFolder & "\" & Mycustomer & "-" & myFolders(myIndex)
    Next myIndex
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Sheet1.Activate
    'Worksheets("This Sheet").Copy
    'ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Daily Reports\" & VBA.Format(VBA.Now, "dd-MMM-yyyy") & _
    " Excel Files" & "\" & VBA.Format(VBA.Now, "dd-MMM-yyyy") & "-1 PHJ Daybook" & "\Daybook Import Sheet.xlsx"
   
    Sheet1.Activate
    Worksheets("This Sheet").Copy
    ActiveWorkbook.SaveAs myPackFolder & "\" & Mycustomer & "-" & myFolders(0) & "\Daybook Import Sheet.xlsm", 52
   
 
   ' Sheet1.Copy
   ' Application.DisplayAlerts = False
   ' ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Daily Reports\" & VBA.Format(VBA.Now, "dd-MMM-yyyy") & _
    " Excel Files" & "\" & VBA.Format(VBA.Now, "dd-MMM-yyyy") & "-1 PHJ Daybook" & "\Daybook Import Sheet.xlsm"
   
   
    MsgBox ("The record folders and PPS Import File have been created for: ") & Mycustomer, vbInformation + vbOKOnly, "Folder Created"
 
End Sub




Fluff said:
Not sure why you would get that error there, but try
VBA Code: 
ActiveWorkbook.SaveAs myPackFolder & "\" & Mycustomer & "-" & myFolders(0) & "\Daybook Import Sheet.xlsm", 52
Click to expand...
 
Last edited by a moderator:
Upvote 0

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Sorry, I have mess something.
I forgot folder "\Daily Reports\".
Suppose you have this folder created (take a care if is there).
Error "9" may occur if sheet you trying to save not exist.
Check this and try to save workbook with ".xlsx".
 
Upvote 0
You've got too many \ in the file path, try
VBA Code: 
Sub make_folders()

Dim myPackFolder As String
    Dim myFolder As String
    Dim Mycustomer As String
    Dim myFolders()
    Dim myIndex As Integer
    Dim myfilepath As String
 
    Application.ScreenUpdating = False
    ReDim myFolders(99)
    myFolders(0) = "1 PHJ Daybook"
    myFolders(1) = "2 PPS System Import File"
    myFolders(2) = "3 Engineers Route Planners"
    myFolders(3) = "4 PPS Web App Day Report"
    myFolders(4) = "5 Additional Information"
    myfilepath = ThisWorkbook.Path
    myFolder = myfilepath & "\Daily Reports\"
    Mycustomer = VBA.Format(VBA.Now, "dd-MMM-yyyy")
    myPackFolder = myFolder & Mycustomer & " Excel Files"
    'check if folders already exist
    If Dir(myPackFolder, vbDirectory) = "" Then
         MkDir myPackFolder
    Else
         MsgBox "This date alread exists." & vbCr & vbCr & "Please check and try again.", vbExclamation, "Folder Error"
         Exit Sub
    End If
    For myIndex = 0 To UBound(myFolders)
    If myFolders(myIndex) = "" Then
         Exit For
    End If
    MkDir myPackFolder & "\" & Mycustomer & "-" & myFolders(myIndex)
    Next myIndex
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
    Sheet1.Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs myPackFolder & "\" & Mycustomer & "-" & myFolders(0) & "\Daybook Import Sheet.xlsx", 51
   
 
   
   
    MsgBox ("The record folders and PPS Import File have been created for: ") & Mycustomer, vbInformation + vbOKOnly, "Folder Created"
 
End Sub
 
Upvote 0
Fluff said:
VBA Code:
Code: 
Sub make_folders()

Dim myPackFolder As String
    Dim myFolder As String
    Dim Mycustomer As String
    Dim myFolders()
    Dim myIndex As Integer
    Dim myfilepath As String

    Application.ScreenUpdating = False
    ReDim myFolders(99)
    myFolders(0) = "1 PHJ Daybook"
    myFolders(1) = "2 PPS System Import File"
    myFolders(2) = "3 Engineers Route Planners"
    myFolders(3) = "4 PPS Web App Day Report"
    myFolders(4) = "5 Additional Information"
    myfilepath = ThisWorkbook.Path
    myFolder = myfilepath & "\Daily Reports\"
    Mycustomer = VBA.Format(VBA.Now, "dd-MMM-yyyy")
    myPackFolder = myFolder & Mycustomer & " Excel Files"
    'check if folders already exist
    If Dir(myPackFolder, vbDirectory) = "" Then
         MkDir myPackFolder
    Else
         MsgBox "This date alread exists." & vbCr & vbCr & "Please check and try again.", vbExclamation, "Folder Error"
         Exit Sub
    End If
    For myIndex = 0 To UBound(myFolders)
    If myFolders(myIndex) = "" Then
         Exit For
    End If
    MkDir myPackFolder & "\" & Mycustomer & "-" & myFolders(myIndex)
    Next myIndex
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
    Sheet1.Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs myPackFolder & "\" & Mycustomer & "-" & myFolders(0) & "\Daybook Import Sheet.xlsx", 51
  

  
  
    MsgBox ("The record folders and PPS Import File have been created for: ") & Mycustomer, vbInformation + vbOKOnly, "Folder Created"

End Sub
Click to expand...
 
Upvote 0
Hi Fluff

sorry for being tardy with my reply

walked into 1st day of month s@#t this morning, bills to pay .......

I hope England win the grand slam :rolleyes: perfect, you are a diamond

cheeeeeers

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

Similar threads

S
  • Solved
For each row, create new folder based on single cell value, then save exported XML doc to matching folder.
Replies
3
Views
167
shand
S
VBAAccountant
  • Solved
Copy Multiple Worksheets to New Folders
Replies
3
Views
451
VBAAccountant
VBAAccountant
jerry12302
  • Question
Prevent Windows popup options when copying or extracting files that already exist in the folder. (Force Copy and Replace, or other options)
Replies
5
Views
985
rollis13
rollis13
A
  • Solved
Copying files to a newly created folder named from data within spreadsheet
Replies
2
Views
209
AndyEd
A
K
  • Question
VBA Code to Copy & Paste Values as is on CSV file format
Replies
0
Views
546
kkoruni
K

Forum statistics

Threads
1,214,935
Messages
6,122,337
Members
449,078
Latest member
skydd

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