copy single worksheet from a workbook to folder

paulsolar

Well-known Member
Joined
Aug 21, 2013
Messages
647
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
 

paulsolar

Well-known Member
Joined
Aug 21, 2013
Messages
647
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




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

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

EXCEL MAX

Active Member
Joined
Nov 11, 2020
Messages
392
Office Version
  1. 2016
Platform
  1. Windows
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".
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,794
Office Version
  1. 365
Platform
  1. Windows
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
 

paulsolar

Well-known Member
Joined
Aug 21, 2013
Messages
647
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
 

paulsolar

Well-known Member
Joined
Aug 21, 2013
Messages
647
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
 

Watch MrExcel Video

Forum statistics

Threads
1,128,141
Messages
5,628,947
Members
416,354
Latest member
JojoMaque

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
Top