vba - このコードを簡単にするために

Question

マクロから記録されたこのコードがあります。プロセスを終了させるために、コードを何度もコピーする必要があります。

プロセスが完了するまでループを作成するのを手伝ってください。

Sub Macro1()

    Sheets("Sheet1").Select
    Range("D2:E2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALB1").Select
    Range("C1").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D3:E3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALB2").Select
    Range("C1").Select
    ActiveSheet.Paste
    '
    '
    '
    '
    Sheets("Sheet1").Select
    Range("D127:E127").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALB126").Select
    Range("C1").Select
    ActiveSheet.Paste

End Sub

Answer 1

ついに私はここで私の問題の解決策を見つけましたそれは

Sub Check_After()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim lCount As Long
Dim lCountA As Long
Dim lCountB As Long
Dim lNum As Long

lCount = 0
lCountA = 2
lCountB = 1

lNum = 127
Set Sh1 = Sheets("Sheet1")
Set Sh2 = Sheets("ALB" & lCountB)
Do
    Set Sh2 = Sheets("ALB" & lCountB)
    Sh1.Range("D" & lCountA & ":E" & lCountA).Copy Sh2.Range("C1")

    lNum = lNum - 1
    lCount = lCount + 1


    lCountA = lCountA + 1
    lCountB = lCountB + 1

Loop Until lNum = 1
MsgBox "The Do Until loop made " & lCount & " loop(s)."

サブ終了

Answer 2

このようなもの：

Sub Macro1()
  Dim Sh1 As WorkSheet, Sh2 As WorkSheet
  Set Sh1 = Sheets("Sheet1")
  Set Sh2 = Sheets("ALB1")

  Dim R As Long
  For R = 2 to 127
    Sh1.Range("D" & R & ":E" & R).Copy Sh2.Range("C" & R - 1)
  Next R
End Sub

またはさらに良い：

Sheets("ALB1").Range("C1:D126") = "=Sheet1!D2"

範囲の最初のセルで機能する数式を範囲全体に割り当てることは、最初のセルに数式を入力し、それを右下にコピーすることと同じです。