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

End Sub

使这段代码更简单

2 个答案: