Excel Macro - to move selected sheets no a new workbook and save, and save some other sheets as separate pdf

[manekankit]

Hi All,

I am trying to do the following with my worksheet. Nee the help form community friends with the coding in excel.

part 1 Save as - selected worksheets

1. I am having an excel file which contains say 10 sheets (Say the name of file is "myworkbook")
2. first sheet is named as "Index"
3. column "A" of the index sheet contains names of certain sheets from the same file.
4. Names are given in A1, A2, A3 and so on. This list in column is changing and not fixed, I mean column A can contain say 5 sheet names from A1 to A5 or say 7 sheet names from A1 to A7).
5. I need to select all those sheets which are listed in column A
6. the macro should create a folder called "export" at the same location of "myworkbook" file. (eg. if pat of "myworkbook" file is desktop, macro should create a folder called "export" on desktop. if there is already such folder it should go to the next step.
7. then macro should create a sub-folder in the export folder. name of this folder should be based on time, i.e. name should be YYYY-MM-DD
8. Now the selected sheeets (as referred to in sr. 4 and 5 above) should be saved in the sub-folder created at Sr. 7 above. file name should be say "newbook" prefixed with time stamp yyyy-mm-dd
9. external links in "newbook" should be broken (i.e. break all links in "newbook")

part 2 Save sheets as separate pdf files

10. column "B" of the index sheet contains names of certain sheets from the same file.
11. Names are given in B1, B2, B3 and so on. This list in column is changing and not fixed, I mean column B can contain say 5 sheet names from B1 to B5 or say 7 sheet names from B1 to B7).
12. I need to convert each of those sheets which are listed in column B and save them separately as pdf in the same folder as referred in sr. 8 above. Name of these files to be name of the respective sheet.

Request you to help me with coding.

 

[DanteAmor]

I help you with part 1:

Sub Save_Sheets()
'
    Dim hojas(), h As Worksheet
    Dim n As Long, i As Long, u As Long
    Dim ruta As String, ruta2 As String, ruta3 As String, nFile As String
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h = Sheets("Index")
    '
    n = 0
    u = h.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To u
        ReDim Preserve hojas(n)
        hojas(n) = h.Cells(i, "A").Value
        n = n + 1
    Next
    '
    nFile = Format(Date, "yyyy-mm-dd")
    ruta = ThisWorkbook.Path
    ruta2 = ruta & "\" & "export"
    If Dir(ruta2, vbDirectory) = "" Then
        MkDir ruta2
    End If
    ruta3 = ruta2 & "\" & nFile
    If Dir(ruta3, vbDirectory) = "" Then
        MkDir ruta3
    End If
    Sheets(hojas).Copy
    ActiveWorkbook.SaveAs Filename:=ruta3 & "\" & "newbook " & nFile & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close
    MsgBox "Finish", vbInformation
End Sub

 

[manekankit]

I help you with part 1:

Sub Save_Sheets()
'
    Dim hojas(), h As Worksheet
    Dim n As Long, i As Long, u As Long
    Dim ruta As String, ruta2 As String, ruta3 As String, nFile As String
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h = Sheets("Index")
    '
    n = 0
    u = h.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To u
        ReDim Preserve hojas(n)
        hojas(n) = h.Cells(i, "A").Value
        n = n + 1
    Next
    '
    nFile = Format(Date, "yyyy-mm-dd")
    ruta = ThisWorkbook.Path
    ruta2 = ruta & "\" & "export"
    If Dir(ruta2, vbDirectory) = "" Then
        MkDir ruta2
    End If
    ruta3 = ruta2 & "\" & nFile
    If Dir(ruta3, vbDirectory) = "" Then
        MkDir ruta3
    End If
    Sheets(hojas).Copy
    ActiveWorkbook.SaveAs Filename:=ruta3 & "\" & "newbook " & nFile & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close
    MsgBox "Finish", vbInformation
End Sub

Hi Dante Amor,

thank you for the help. it is running exactly the way i had wanted.

further i am looking to create backup also. i am using below code but it is returning error. can you please help with this? Thanks.

Sub backupfile()


Dim ruta As String, ruta2 As String, ruta3 As String, ruta4 As String, nFile As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
nFile = Format(Date, "dd-mmm-yyyy")
ruta = Application.ActiveWorkbook.Path
ruta2 = ruta & "" & "export"
If Dir(ruta2, vbDirectory) = "" Then
MkDir ruta2
End If
ruta3 = ruta2 & "" & "Back up"
If Dir(ruta3, vbDirectory) = "" Then
MkDir ruta3
End If
ruta4 = ruta3 & "" & nFile
If Dir(ruta4, vbDirectory) = "" Then
MkDir ruta4
End If

Dim savedate
savedate = Date
Dim savetime
savetime = Time
Dim formattime As String
formattime = Format(savetime, "hh.MM.ss")
Dim formatdate As String
formatdate = Format(savedate, "DD - MM - YYYY")
Application.DisplayAlerts = False


Dim backupfolder As String
backupfolder = ruta4
ActiveWorkbook.SaveCopyAs Filename:=backupfolder & formatdate & " " & formattime & " " & ActiveWorkbook.Name
ActiveWorkbook.Save
Application.DisplayAlerts = True
MsgBox "Backup Run. Please Check at: " & backupfolder & " !"


End Sub