Как сделать так, чтобы эта запись макроса Excel повторялась в следующих строках, пока не осталось больше данных? - PullRequest
0 голосов
/ 30 марта 2019

Я довольно новичок в VBA, и теперь я хочу, чтобы этот код записи макросов повторил это в ячейке 1, затем в ячейке 2, затем в ячейке 3, пока в столбце A не останется больше полей данных. В основном это должно быть скопировать ячейку в A1 и скопировать в книгу 2, затем нажать обновить данные, а затем скопировать некоторую информацию обратно в Book1 и повторять от 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 Ответ

1 голос
/ 31 марта 2019

Вы можете сделать что-то вроде этого:

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...