Copy the values of an alternating column to a specific cell and print the sheet

[sofas]

In Sheet 1, I fetch data from Sheet 2 when I enter the customer's name in cell t1 using formulas. I want a code that enables me to automatically fetch the names in column B of Sheet 2, starting from row 9, to the last name on the column, to cell t1, alternately. Unit by unit. At each change, the invoices are printed and saved in pdf format in the same file path with the customer’s name. That is, fetching name 1. And print the sheet, then bring name 2, print the sheet, and so on......

 

[sofas]

After several attempts, but unfortunately I was not able to fulfill the requirement. It saves only one customer’s name

Public Sub Create_Invoices()

Dim path As String, folderName As String, fileName As String
Dim Cpt As Range
Dim y As Integer
  

Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
Dim dest As Worksheet: Set dest = Worksheets("Sheet2")

    path = ThisWorkbook.path & "\"
    
    Set Cpt = dest.Range("t1")
    
    ws.Activate

On Error Resume Next
folderName = "Invoices"
fileName = folderName & "\" & Cpt & ".pdf"

MkDir path & folderName

For y = 9 To ws.Cells(Rows.Count, "b").End(xlUp).Row 'location of names
        Cpt.Value = ws.Cells(y, "b").Value
        
        
        If IsLeapYear(y) Then
         dest.Select
      
        End If


dest.ExportAsFixedFormat Type:=xlTypePDF, fileName:=path & fileName
    Next
    
    Cpt.Worksheet.Select
    
End Sub

 

[Skyybot]

You enter names on Sheet1 Cell T1?

 

[sofas]

You enter names on Sheet1 Cell T1?

Yes

 

[Skyybot]

And which Sheet gets printed and saved?

 

[sofas]

And which Sheet gets printed and saved?

SHEET2

Sub Create_PDF()
Dim path As String
Application.ScreenUpdating = False

Dim WS1 As Worksheet, WS2 As Worksheet

Set WS1 = Worksheets("Sheet2")
Set WS2 = Worksheets("Sheet1")


path = ThisWorkbook.path & "\"
For r = 9 To WS2.Cells(Rows.Count, "b").End(xlUp).Row
Names_list = WS2.Cells(r, "B")
WS1.[T1] = Names_list


'WS1.ExportAsFixedFormat Type:=xlTypePDF, fileName:=path & Names_list & ".pdf"



 WS1.ExportAsFixedFormat Type:=xlTypePDF, fileName:=path & Names_list, _
      Quality:=xlQualityStandard, IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, OpenAfterPublish:=True
Next r
 
Application.ScreenUpdating = False

End Sub

So far I have achieved this. I just want to create a folder and save the file inside it, and let all the invoices be on one sheet below each other. Because now it saves the invoices separately, each sheet on its own.

 

[Skyybot]

Ok. Try this. On a copy of your Workbook as usual. This will save your PDF's to C:\Users\*UserName*\Documents\Invoices. I had to do this because our Workbook paths are different.

Sub CreatePDF()
Dim wb As Workbook, wsData As Worksheet, wsDest As Worksheet, cName As Range, cList As Range, cell As Range
Dim lRow As Long, i As Integer
Dim fPath As String, fFolder As String, fName As String
fPath = "C:\Users\" & Application.UserName & "\Documents\Invoices"
MkDir fPath
Set wb = ThisWorkbook: Set wsData = wb.Sheets("Sheet1"): Set wsDest = wb.Sheets("Sheet2")
lRow = wsDest.Columns("B").Rows(wsDest.Rows.Count).End(xlUp).Row
Set cName = wsData.Range("T1"): Set cList = wsDest.Range(Range("B9"), Range("B" & lRow))
For Each cell In cList
    cName.Value = cell.Value
    fName = cName.Value
    wsDest.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & "\" & fName & ".pdf", OpenAfterPublish:=False
Next cell
End Sub

 

[sofas]

SHEET2

Ok. Try this. On a copy of your Workbook as usual. This will save your PDF's to C:\Users\*UserName*\Documents\Invoices. I had to do this because our Workbook paths are different.

Sub CreatePDF()
Dim wb As Workbook, wsData As Worksheet, wsDest As Worksheet, cName As Range, cList As Range, cell As Range
Dim lRow As Long, i As Integer
Dim fPath As String, fFolder As String, fName As String
fPath = "C:\Users\" & Application.UserName & "\Documents\Invoices"
MkDir fPath
Set wb = ThisWorkbook: Set wsData = wb.Sheets("Sheet1"): Set wsDest = wb.Sheets("Sheet2")
lRow = wsDest.Columns("B").Rows(wsDest.Rows.Count).End(xlUp).Row
Set cName = wsData.Range("T1"): Set cList = wsDest.Range(Range("B9"), Range("B" & lRow))
For Each cell In cList
    cName.Value = cell.Value
    fName = cName.Value
    wsDest.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & "\" & fName & ".pdf", OpenAfterPublish:=False
Next cell
End Sub

Very beautiful. Is it possible to combine files on one PDF page?

 

[Skyybot]

Very beautiful. Is it possible to combine files on one PDF page?

You would have to know the exact Range you want to "print" and copy each Range change to a new Sheet, then save that Sheet.

 

[sofas]

You would have to know the exact Range you want to "print" and copy each Range change to a new Sheet, then save that Sheet.

Range("a1:i46")