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......

 

[Skyybot]

Range("a1:i46")

Of which Sheet?

 

[sofas]

wsData

 

[Skyybot]

Range("a1:i46")

wsData

Oh no. I was saving the wrong Sheet in the code I posted. Sorry.

 

[Skyybot]

Also, originally each file was saved as a customer name. If all of the saves go in to one PDF, what do you want to name it?

 

[sofas]

Also, originally each file was saved as a customer name. If all of the saves go in to one PDF, what do you want to name

Also, originally each file was saved as a customer name. If all of the saves go in to one PDF, what do you want to name it?

Invoices

 

[Skyybot]

Okay. Give this a shot.

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, wsInv As Worksheet
Dim fPath As String, fFolder As String, fName As String
fPath = "C:\Users\" & Application.UserName & "\Documents\Invoices"
If Dir(fPath, vbDirectory) = "" Then
    MkDir fPath
End If
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("B9:B" & lRow)
Set wsInv = Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
i = 1
For Each cell In cList
    cName.Value = cell.Value
    fName = cName.Value
    wsData.Range("A1:I46").Copy
    wsInv.Cells(i, 1).PasteSpecial Paste:=xlPasteValues
    i = i + 46
    wsInv.HPageBreaks.Add (wsInv.Rows(i))
Next cell
wsInv.PageSetup.FitToPagesTall = 1
Application.DisplayAlerts = False
wsInv.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & "\Invoices.pdf", IgnorePrintAreas:=False, OpenAfterPublish:=False, _
     IncludeDocProperties:=True
wsInv.Delete
Application.DisplayAlerts = True
End Sub

 

[sofas]

Okay. Give this a shot.

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, wsInv As Worksheet
Dim fPath As String, fFolder As String, fName As String
fPath = "C:\Users\" & Application.UserName & "\Documents\Invoices"
If Dir(fPath, vbDirectory) = "" Then
    MkDir fPath
End If
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("B9:B" & lRow)
Set wsInv = Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
i = 1
For Each cell In cList
    cName.Value = cell.Value
    fName = cName.Value
    wsData.Range("A1:I46").Copy
    wsInv.Cells(i, 1).PasteSpecial Paste:=xlPasteValues
    i = i + 46
    wsInv.HPageBreaks.Add (wsInv.Rows(i))
Next cell
wsInv.PageSetup.FitToPagesTall = 1
Application.DisplayAlerts = False
wsInv.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & "\Invoices.pdf", IgnorePrintAreas:=False, OpenAfterPublish:=False, _
     IncludeDocProperties:=True
wsInv.Delete
Application.DisplayAlerts = True
End Sub

Thank you very much. This is what is really needed. operation accomplished successfully .