単一行で実行されるコードの行範囲のループを作成する

Question

自動レポートを作成するマクロ（レポートシートの名前は「RCCP INPUT」）を作成し、別の行からデータを抽出しますワークシート（「CW33 17」という名前の出典）。私は、ソースシートの単一の行のために実行するコードをビルドしたので、1行だけのためのレポートを作成します（すべての行は注文を表します）。さまざまな行のレポートを作成したいので、ある範囲の行を適用するためにコードを拡張する必要があります。したがって、この範囲はmyRangeと呼ばれ、2から70までの行が含まれています。したがって、レポートにはこれらの行がすべて含まれている必要があります。私のコードは以下の通りです。私はヘッダーも含めているので、レポートは2行目から開始します。マクロが実行される行は今のところ2行目です。レポートをより明確にするために、ソースから選択された各行に6を掛けなければなりません予測列と予測数量列では、各注文（行）が6週間の値を持たなければならないため、下のマクロから見ることができるように、6個のコピー（下に1つずつ）が必要です。私はそれを明確にしたことを願っています！どのようにそれを動作させるためにどのようなアイデア？..私はこれまでに惨めに失敗しました..多くの感謝！

レポートは次のようになります（1つの行には6が掛けられるため）、他の行は同じように下に配置されます。あなたは何とか絶対アドレスから離れて移動する必要があなたのコードを一般化するために

Sub RCCP_INPUT() 

Sheets("RCCP INPUT").Select 

    range("C1").Value = "T-Lane ID"     'Column C 
    range("D1").Value = "Week of RCCP"     'Column D 
    range("E1").Value = "Forecast"      'Column E 
    range("F1").Value = "Forecast Quantity"   'Column F 

    Sheets("CW33 17").Select 
    range("D2:E2").Copy 
    Sheets("RCCP INPUT").Select 
    range("A2").Select 
    ActiveSheet.Paste 
    Dim rws As Long 
    With range("A2:B2") 
    rws = .Rows.Count 
    .Resize(rws).Copy Destination:=.Offset(rws).Resize(rws * 5) 
    End With 
    range("C2").Select 
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])" 
    ActiveCell.Value = ActiveCell.Value 
    With range("C2") 
    rws = .Rows.Count 
    .Resize(rws).Copy Destination:=.Offset(rws).Resize(rws * 5) 
    End With 
    Sheets("CW33 17").Select 
    range("G2:L2").Select 
    Selection.Copy 
    Sheets("RCCP INPUT").Select 
    range("F2:F7").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True 
    Sheets("RCCP INPUT").Select 
    i = 1 
    For Each cell In range("E2:E7") 
     cell.Value = "Week +" & i 
     i = i + 1 
    Next cell 
    Sheets("RCCP INPUT").Select 
    range("E2").Value = Sheets("CW33 17").range("G2").Value - 1 
    With range("E2") 
    rws = .Rows.Count 
    .Resize(rws).Copy Destination:=.Offset(rws).Resize(rws * 5) 
    End With 

End Sub 

Answer 1

。 1つの方法は、範囲を割り当て、必要に応じてそれらをオフセットして、必要な位置に到達させることです。以下のコードはnumNeeded回実行され、あなたが言及したとおり、すぐ下に追加し続けます。最初のデータの後にソースデータについて何も知らないので、今すぐ最初のデータセットを繰り返すだけです。しかし、異なるシートから新しいデータを描画したり、ソースシート上のオフセットを使って毎回新しいデータを取得することができます。コード内に多くのr.selectステートメントを挿入して、コードを実行していることを簡単に確認できるようにしましたが、理解したら削除する必要があります。

Sub reportGen() 
    Dim destSh As Worksheet, sourceSh As Worksheet 
    Dim sourceR1 As Range, sourceR2 As Range 
    Dim r As Range, pasteR As Range 
    Const numNeeded = 10 
    Set sourceSh = Worksheets("CW33 17") 
    Set sourceR1 = sourceSh.Range("D2:E2") 
    Set sourceR2 = sourceSh.Range("G2:L2") 
    Set destSh = Worksheets("RCCP INPUT") 
    Set r = destSh.Range("A1").Offset(7 * j, 0) 
    r.Select 
    r.Offset(0, 2) = "T-Lane ID" 
    r.Offset(0, 3) = "Week of RCCP" 
    r.Offset(0, 4) = "Forecast" 
    r.Offset(0, 5) = "Forecast Quantity" 
    For j = 0 To numNeeded 
    Set r = destSh.Range("A2").Offset(j * 6, 0) 
    r.Select 
    sourceR1.Copy 
    destSh.Paste 
    Set pasteR = Selection 
    pasteR.AutoFill destSh.Range(pasteR, pasteR.Offset(5, 0)) 
    Set r = r.Offset(0, 2) 
    r.Select 
    r.FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])" 
    r = r.Value 
    r.AutoFill destSh.Range(r, r.Offset(5, 0)) 
    Set r = r.Offset(0, 3) 
    r.Select 
    sourceR2.Copy 
    r.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True 
    Set r = r.Offset(0, -1) 
    r.Select 
    For i = 1 To 6 
     r.Offset(i - 1, 0) = "Week +" & i 
    Next i 
    r = sourceR2(1) - 1 
    r.AutoFill destSh.Range(r, r.Offset(5, 0)) 
    r.Select 
    Next j 
End Sub 

（ちなみに、これだけそれをあなたがそれを持って道を保って、私はそれがデータに上書きするので、あなたのFor Each cell...ループの後に始まる間違いがあるかもしれないと思うが、私は確認されませんでした）