我如何使此Excel宏录制在下一行重复进行,直到没有更多数据

时间:2019-03-30 19:12:23

标签: excel vba

我对VBA相当陌生,我希望做的是使此宏记录代码在Cell 1然后Cell 2然后在Cell 3上重复此操作,直到A col中没有剩余的数据字段为止。基本上,应该将其复制到A1中的一个单元格并复制到书2中,然后点击刷新数据,然后再将一些信息复制回Book 1中 并从A1开始重复,直到A列中不再有剩余单元格

我尝试阅读以在线方式进行阅读,但无法弄清楚

Sub Macro1()
'
' Macro1 Macro
'

'
Range("A2").Select
Selection.Copy
Windows("Book2").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.RefreshAll
Windows("Book1").Activate
Range("F2").Select
Windows("Book2").Activate
Range("K6").Select
Selection.Copy
Windows("Book1").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
    :=False, Transpose:=False
Windows("Book2").Activate
Range("L6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Book1").Activate
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
    :=False, Transpose:=False
Range("G3").Select
End Sub

1 个答案:

答案 0 :(得分:1)

您可以执行以下操作:

Sub Macro1()
    Dim c As Range, sht2 As Worksheet

    'adjust sheet names as required    
    Set c = Workbooks("Book1").Sheets("Sheet1").Range("a2")
    Set sht2 = Workbooks("Book2").Sheets("Sheet1")

    Do while Len(c.value) > 0

        sht2.Range("A2").Value = c.value
        sht2.Parent.RefreshAll

        'fixed source cells
        c.EntireRow.Cells(6).Value = sht2.Range("K6").Value
        c.EntireRow.Cells(7).Value = sht2.Range("L6").Value 

        '...or last populated cells in K,L
        c.EntireRow.Cells(6).Value = sht2.Cells(rows.count, "K").End(xlUp).Value
        c.EntireRow.Cells(7).Value = sht2.Cells(rows.count, "L").End(xlUp).Value 

        Set c = c.Offset(1, 0) 'next cell down
    Loop


End Sub