Excel VBA Loop Through Column and Save Result - vba

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