Loop with a list and save worksheet separately in a specific path

[VBANoob00]

Hi,

Need help. See code below.

Sub Create_PDF()

Application.ScreenUpdating = False

Dim rs1 As Worksheet, rs2 As Worksheet

Set rs1 = Worksheets("Sheet1")
Set rs2 = Worksheets("Sheet2")

myPath = "C:\Users\ELPADILL\OneDrive - Schenker AG\Desktop\2025 Target Agreement\2024 STIP1 Template & Letters\2024 Target Bonus"

For r = 2 To 6

empName = rs2.Cells(r, "B")
rs1.[B2] = empName

Set Rng = rs1.Range("A1:W41")
Rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myPath & " - " & empName & ".pdf"

Next r
 
Application.ScreenUpdating = False

End Sub

What it does are...

1. Worksheet1 (main worksheet) - calls each name on worksheet2, updates other cells based on data on worksheet3, and the code saves each separately as pdf
2. Worksheet2 (list of names) - there are list of names that needs to be looped
3. Worksheet3 (data) - data looked up by worksheet1

Output is separate pdf files for each name on worksheet.

What I want is for the code to save is as excel file (.xls)

Thanks!

 

[VBANoob00]

Sorry this is my first post and don't know how to edit the original post. Anyway, so what current what the code does is it saves worksheet1 as pdf files for each name on worksheet2.
So if worksheet2 has 5 names once code is executed it will save 5 pdfs on a specific folder.

What I want is for the code to save worksheet1 as excel file (.xls).

 

[MikeVol]

Hi, maybe like

Option Explicit

Sub Create_PDF()
    Application.ScreenUpdating = False
    Dim r As Long, Rng As Range
    Dim wbNew       As Workbook

    Dim rs1 As Worksheet, rs2 As Worksheet
    Set rs1 = Worksheets("Sheet1")
    Set rs2 = Worksheets("Sheet2")

    Dim myPath As String, empName As String
    myPath = "C:\Users\ELPADILL\OneDrive - Schenker AG\Desktop\2025 Target Agreement\2024 STIP1 Template & Letters\2024 Target Bonus"

    For r = 2 To 6
        empName = rs2.Cells(r, "B")
        rs1.[B2] = empName

        Set Rng = rs1.Range("A1:W41")
        Set wbNew = Workbooks.Add

        Rng.Copy Destination:=wbNew.Sheets(1).Range("A1")
        wbNew.SaveAs Filename:=myPath & " - " & empName & ".xls", FileFormat:=xlExcel8
        wbNew.Close SaveChanges:=False
        '        Rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myPath & " - " & empName & ".pdf"
    Next r

    Application.ScreenUpdating = False
End Sub

 

[VBANoob00]

Thanks!

There was an error though

Run-time error '1004':

Method 'SaveAs' of object'_Workbook' failed

Also forgot to mention, you can remove this part...

Set Rng = rs1.Range("A1:W41")

As I want to copy the whole worksheet1

Still thanks for replying immediately

 

[MikeVol]

As I want to copy the whole worksheet1

Sorry, where do I get the name (empName) for the new file?

 

[MikeVol]

Okay, I'll take the name (empName) of the new workbook from the same nested loop.

Option Explicit

Sub CreateNewBook()
    Dim r           As Long
    Dim wbNew       As Workbook

    Dim rs1 As Worksheet, rs2 As Worksheet
    Set rs1 = ThisWorkbook.Worksheets("Sheet1")
    Set rs2 = ThisWorkbook.Worksheets("Sheet2")

    Dim myPath As String, empName As String
    myPath = "C:\Users\ELPADILL\OneDrive - Schenker AG\Desktop\2025 Target Agreement\2024 STIP1 Template & Letters\2024 Target Bonus"
    Application.ScreenUpdating = False

    For r = 2 To 6

        With rs1
            empName = rs2.Cells(r, "B")
            rs1.[B2] = empName
            .Copy

            Set wbNew = ActiveWorkbook
            wbNew.SaveAs Filename:=myPath & " - " & empName & ".xls", FileFormat:=xlExcel8
            wbNew.Close SaveChanges:=False
        End With

    Next r

    Application.ScreenUpdating = False
End Sub

 

[VBANoob00]

Worked! Though it created extra copies of 1st name on the list but it worked. Thank you very much!