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 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"

将适用于范围的第一个单元格的公式分配给整个范围相当于在第一个单元格上键入公式并向右和向下复制它。

Answer 2

最后我在这里找到了我的问题的解决方案

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)."

结束子