VBAループスルー文字列

Question

データセットの内容をフィルタリングして他のシートに貼り付けるためには、かなりの変数をループする必要があります。

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 

を次のように私は、データを貼り付ける必要があり、コードがあるソースは常に同じですが、「SelectionABC」と「DestinationXは、」変更されます。選択とデトネーションがペアになっているので、 "SelectionABC"がシート "Destination1"に、 "SelectionDEF"がシートDestination2に、...

どのように私は選択しないでください&の宛先をループすることができます各データ転送のコードを繰り返しますか？

Answer 1

ここには、あなたが手伝ってくれる簡単なテストされていないコードがあります。

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