Loop a code to extract sequential column data to different sheets - vba

Question

I apologise for what might be a messy code and/or simple question.
I have searched this site and web and tried various code pieces but my understanding and patience is too limited for the current task. I appreciate your more knowledgeable experience. Now the question..:
I would like to loop a piece of code so that it can be implemented for different ranges. I start with two sheets of data, the second of which contains the refined data with around 66 columns, the first two columns of which will be used for each new sheet. The code first filters the third column and copies the first two and third column, creates a new sheet and pastes the values. Then it returns to Sheet2 to remove the filter and do the same actions for the fourth column.
Since each iteration has repetition e.g. 3, 4, 5... I would like to create a variable that can be used to loop code and make it a lot neater as well as simple to limit the number of loops to the number of columns - 2 (the first two columns). So instead of me writing this code 64 times and changing it for another workbook with 100 columns, I would like to change just a few variables and ranges, if that is a possibility.
Sub CopyPaste()
Dim rg As Range
Set rg = ActiveSheet.Range("$A$1:$BN$5279")
rg.AutoFilter Field:=3, Criteria1:="<>"
Union(Columns(1), Columns(2), Columns(3)).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet2").Select
rg.AutoFilter Field:=3
rg.AutoFilter Field:=4, Criteria1:="<>"
Union(Columns(1), Columns(2), Columns(4)).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet2").Select
rg.AutoFilter Field:=4
rg.AutoFilter Field:=5, Criteria1:="<>"
Union(Columns(1), Columns(2), Columns(5)).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet2").Select
rg.AutoFilter Field:=5
End Sub
Thank you,
Ricky

Answer 1

Something like this should work for you. You can adjust the for loop as needed to loop through all the columns needed. This avoids the selection pieces, resets the filters when done with each iteration, and is easy to adjust for any changes in numbers of columns. It will also programmatically find the last row instead of the sheet range instead of hard coding it in.
Sub CopyPaste()
Dim rg As Range
Dim LastRow As Long
LastRow = Sheets("Sheet2").Range("A1").SpecialCells(xlCellTypeLastCell).Row
Set rg = Sheets("Sheet2").Range("A1:BN" & LastRow)
For i = 3 To 5
rg.AutoFilter Field:=i, Criteria1:="<>"
Union(Columns(1), Columns(2), Columns(i)).Copy
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Cells(1, 1).PasteSpecial Paste:=xlPasteValues
rg.AutoFilter
Next i
End Sub

Answer 2

There might be a better way to approach this but just to put it in a loop, try the below code:
Sub CopyPaste()
Dim rg As Range: Set rg = ActiveSheet.Range("$A$1:$BN$5279")
For iC = 3 To 64
rg.AutoFilter Field:=iC, Criteria1:="<>"
Union(Columns(1), Columns(2), Columns(3)).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet2").Select
rg.AutoFilter Field:=iC
Next
End Sub