copy single worksheet from a workbook to folder

[paulsolar]

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

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

 

[Fluff]

How about

Sheet1.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.xlsm"

 

[paulsolar]

How about

Sheet1.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.xlsm"

Hi Fluff

I think you have it but I'm getting the message in the attached image

 

[paulsolar]

Hi Fluff

I think you have it but I'm getting the message in the attached image

I dont mind it as a csv, in which case i assume it would use the sheet name??

cheers

Paul

 

[Fluff]

You can hide that notice like

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"

 

[paulsolar]

You can hide that notice like

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"

Hi Fluff

it's very close now but I'm getting a different error, see below. I think there is something not quite correct with the path, I'm looking to see if i can figure out what it is

 

[Fluff]

What line of code gives that error?

 

[paulsolar]

What line of code gives that error?

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"

 

[EXCEL MAX]

You have some errors in creating folders path, so if you still have problem here is complete 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"
    MsgBox ("The record folders and PPS Import File have been created for: ") & Mycustomer, vbInformation + vbOKOnly, "Folder Created"
   
End Sub

 

[Fluff]

Not sure why you would get that error there, but try

ActiveWorkbook.SaveAs myPackFolder & "\" & Mycustomer & "-" & myFolders(0) & "\Daybook Import Sheet.xlsm", 52