VBA Loop through strings - vba

Question

I have to loop through a serious of variables to filter the contents of a dataset to paste it to other sheets. The code I have to paste the data is as follows
Sheets("Source").Select
LastRow = ActiveSheet.Range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
If ActiveSheet.AutoFilterMode = False Then ActiveSheet.AutoFilterMode = True 'Enable Filters if not exists
ActiveSheet.Range("$A$3:$AY$" & LastRow).AutoFilter Field:=4, Criteria1:= _
"SelectionABC"
Range("A3:AY" & LastRow).Copy
Sheets("DestinationX").Select
Range("A4").Select
ActiveSheet.Paste
The source is always the same, but the "SelectionABC" and the "DestinationX" will change. The selection and detonation are paired, so "SelectionABC" goes to sheet "Destination1", "SelectionDEF" goes to sheet "Destination2",...
How can I loop through the selection & destination so that I don't have the repeat the code for each data transfer?

Answer 1

Here is a quick untested code to help you get going.
Dim i, j As Long
Dim alpha As String
Dim b As Boolean : b = False
j = 1
'~~> UPPERCASE ALPHABETIC CHARACTERS IN THE
'~~> ASCII TABLE GO FROM 65="A" TO 91="Z"
For i = 65 To 91
If i = 89 Then '~~> BECAUSE WE ARE LEFT WITH LAST TWO LETTERS "YZ"
alpha = Chr(i) & Chr(i + 1)
b = True '~~> TO COME OUT OF LOOP AFTER "YZ"
Else
alpha = Chr(i) & Chr(i + 1) & Chr(i + 2)
i = i + 2
End If
Sheets("Source").Select
LastRow = ActiveSheet.Range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
If ActiveSheet.AutoFilterMode = False Then ActiveSheet.AutoFilterMode = True 'Enable Filters if not exists
ActiveSheet.Range("$A$3:$AY$" & LastRow).AutoFilter Field:=4, Criteria1:= _
"Selection" & alpha '~~> ADDED alpha here
Range("A3:AY" & LastRow).Copy
Sheets("Destination" & j).Select '~~> ADDED j HERE
Range("A4").Select
ActiveSheet.Paste
j = j + 1
If b Then Exit For '~~> TO COME OUT OF LOOP AFTER "YZ"
Next