vbaでカウンタを初期化するには

Question

私のvbaプロジェクトに問題があります。 私のワークブックには、「ドラフト、cky、コイとビー」のシートが4枚あります。「ドラフトにはすべてのデータがあり、それらを再編成したい」というシートの「ドラフト」の列「G」には、コイとベイ） 私のマクロが列を通過し、同じ値を持つすべてのセルをコピーして、セル（A2）から対応するシートに貼り付けます。例：マクロをすべてコピーする「CKY」を持っており、シートに貼り付けたデータ「CKYは、」セルA2から始まるので、/ にあなたは私がこれまで行ってきたものを見ることができます以下：

Sub MainPower() 

Dim lmid As String 
Dim srange, SelData, ExtBbFor As String 
Dim lastrow As Long 
Dim i, j, k As Integer 

    lastrow = ActiveSheet.Range("B30000").End(xlUp).Row 
    srange = "G1:G" & lastrow 
    SelData = "A1:G" & lastrow 



    For i = 1 To lastrow 
     If InStr(1, LCase(Range("E" & i)), "bb") <> 0 Then 
      Range("G" & i).Value = Mid(Range("E" & i), 4, 3) 

      ElseIf Left(Range("E" & i), 1) = "H" Then 
       Range("G" & i).Value = Mid(Range("E" & i), 7, 3) 
      Else 
       Range("G" & i).Value = Mid(Range("E" & i), 1, 3) 
     End If 
    Next i 
'Sorting data 
    Range("A1").AutoFilter 
    Range(SelData).Sort key1:=Range(srange), order1:=xlAscending, Header:=xlYes 

'Spreading to the appropriate sheets 
    j = 1 
    For i = 1 To lastrow 


     If Range("G" & i).Value = "CKY" Then 


      Sheets("CKY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value 

      ElseIf Range("G" & i).Value = "BEY" Then 

      Sheets("BEY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value 

      ElseIf Range("G" & i).Value = "COY" Then 

      Sheets("COY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value 

     End If 
     j = j + 1 

    Next i 


End Sub 

は 最高のを助けるためにありがとう敬具

Answer 1

Forループでこのリファクタリングされたコードを使用してください。

For i = 1 To lastrow 

    Select Case Sheets("Draft").Range("G" & i).Value 

     Case is = "CKY","COY","BEY" 

      Dim wsPaste as Worksheet 
      Set wsPaste = Sheets(Range("G"& i).Value) 

      Dim lRowPaste as Long 
      lRowPaste = wsPaste.Range("A" & .Rows.COunt).End(xlup).Offset(1).Row 

      wsPaste.Range("A" & lRowPaste & ":E" & lRowPaste).Value = _ 
      Sheets("Draft").Range("C" & i & ":G" & i).Value 

    End Select 

Next i