Excel VBA Loop Through Column and Save Result

Question

This is a little challenging to me

I have the following code which works just like I wanted. But I need the code to loop through Sheet1 Column A and copy and paste the value to Sheet2(R1) Then loop through Sheet1 column B and copy each value paste it to Sheet2(I7) then save the worksheet as a new PDF document

See Picture for example excel sheet example

Sub Macro2()
'
' Macro2 Macro
'

'
    Sheets("Sheet1").Select
    Range("A2").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("R1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection.Font
        .Name = "Calibri"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Sheets("Sheet1").Select
    Range("B2").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("I7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection.Font
        .Name = "Calibri"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
        Dim i As Integer
    For i = 1 To 2
    Next i
ThisWorkbook.Sheets("Sheet2").Select
ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=ThisWorkbook.Path & "\" & CStr(i) & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=True, _
        OpenAfterPublish:=False
    End With
End Sub

Answer 1

You can use the following codes to loop through rows and/or columns if you add the function below at the end (below your actual sub) of the same "Module" your sub is located in.

sub yourcode
    ThisWorkbook.Worksheets("worksheetX").range(col_letter(column_number) & rownumber).Value
end sub

Function col_letter(lngCol As Long) As String 'Sub nr_to_letter()
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
col_letter = vArr(0)
End Function

And it will automatically convert the column_number to the column letter in the .range("..

And the following generalized code detects the last row of your column:

    'Find the last used row in a Column: column B in this example
    Dim LastRow As Long
    sheets(name(Sheet)).Select
    sheets(name(Sheet)).Activate

    'MsgBox (Sheet)
    With ActiveSheet
        LastRow = .Cells(.Rows.count, "B").End(xlUp).Row
    End With

I learned a lot of the basics by looking up standard solutions to basic problems I stumbled upon from:

Source: http://www.rondebruin.nl/

And I think this code could perform your desired task:

Sub Macro2()
'
' Macro2 Macro
'

'
Sheets("Sheet1").Select
Range("A2").Select

'detect last row in column A sheet1:
Dim LastRow As Long
Sheets("Sheet1").Select
Sheets("Sheet1").Activate

'MsgBox (Sheet)
With ActiveSheet
    LastRow_A = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
MsgBox (LastRow_A)

'here the function to convert column number to column letter is used:
'Range(col_letter(1) & "2:A" & LastRow).Select
MsgBox ("As you can see the function converts the index of the col_letter to a alphabetic letter: " & col_letter(1))

For loop_through_column_A = 2 To LastRow_A
    Range(col_letter(1) & loop_through_column_A).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("R" & loop_through_column_A - 1).Select 'ensure it starts pasting at row 1
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection.Font
        .Name = "Calibri"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
Next loop_through_column_A

Sheets("Sheet1").Select
Range("B2").Select


'detect last row in column B sheet1:
Dim LastRow_B As Long
Sheets("Sheet1").Select
Sheets("Sheet1").Activate

'MsgBox (Sheet)
With ActiveSheet
    LastRow_B = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
MsgBox (LastRow_B)

'loop through column Sheet1
For loop_through_column_B = 2 To LastRow_B

    Range("B" & loop_through_column_B).Select
    Selection.Copy
    Sheets("Sheet2").Select

    Range("I" & 5 + loop_through_column_B).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection.Font
        .Name = "Calibri"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

    'To save the pdf every iteration (after you have already completely iterated through column A in the first for-loop:
    '"Insert here."

Next loop_through_column_B


'include this in the loop if you want to save the pdf every time you add a different pasted row where it says: "Insert here."
ThisWorkbook.Sheets("Sheet2").Select
ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=ThisWorkbook.Path & "\" & CStr(i) & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=True, _
        OpenAfterPublish:=False

End Sub

'Here the following function IS used:
Function col_letter(lngCol As Long) As String 'Sub nr_to_letter()
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
col_letter = vArr(0)
End Function