Excel VBA - インクリメント付きループ

Question

ソースシートから4行ごとにセルを参照し、出力シートに配置するにはどうすればよいですか？各セルには異なる値があります。事前にありがとう

Answer 1

これは仕事をする必要があります。ワークブックで試す前に、必要なカスタマイズを行ってください。

Sub TransferData() 

    Dim WsS As Worksheet, WsT As Worksheet  ' Source & Target 
    Dim Rl As Long        ' Last row 
    Dim Rs As Long, Cs As Long     ' Source: Row, Column 
    Dim Rt As Long, Ct As Long     ' Target: Row, Column 

    Set WsS = Worksheets("Source")    ' change name as required 
    Set WsT = Worksheets("Source")    ' I used the same sheet for my test 

    With WsT 
     Ct = 4      ' specify the column to write to (here column D) 
     Rt = .Cells(.Rows.Count, Ct).End(xlUp).Row + 1 
    End With 

    Application.ScreenUpdating = False 
    With WsS 
     Cs = 1      ' specify the column to read from (here column A) 
     Rl = .Cells(.Rows.Count, Cs).End(xlUp).Row 
     For Rs = 2 To Rl Step 4     ' start from row 2 
      WsT.Cells(Rt, Ct).Value = .Cells(Rs, Cs).Value 
      Rt = Rt + 1 
     Next Rs 
    End With 
    Application.ScreenUpdating = True 
End Sub