Блог

У меня есть основной лист, его таблица стилей панели инструментов, собирающая информацию из связанных листов (она используется для выборочной проверки). Все результаты для листа управляются одной ячейкой (идентификатором), у меня есть список идентификаторов, которые я хочу пропустить через ячейку, а затем скопировать одну строку результатов и добавить ее на какой-либо другой лист. Я записал функцию, чтобы попытаться объяснить, что я делаю.

 Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[1]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
 

Затем я сделал это несколько раз, чтобы показать, как будет выглядеть весь процесс:

 Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[2]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[3]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[4]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
 

Итак, в целом есть три листа. Ввод данных, в котором отображаются результаты и функции, список, в котором содержится список идентификаторов и результатов, где мне просто нужно добавить одну строку из ввода данных (row32)

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

     Dim wsList As Worksheet, wsData As Worksheet, wsResult As Worksheet
    Dim c As Range, rwDest As Range
    
    Set wsList = ThisWorkbook.Worksheets("List")
    Set wsData = ThisWorkbook.Worksheets("Data Input")
    Set wsResult = ThisWorkbook.Worksheets("Result")

    Set rwDest = wsResult.Rows(3)                'first destination row
    
    For Each c In wsList.Range("A2:A100").Cells  'for example
        If c.Value <> "" Then
            wsData.Range("L3").Value = c.Value
            wsData.Calculate
            rwDest.Value = wsData.Rows(32).Value 'copy row values
            Set rwDest = rwDest.Offset(1, 0)     'next destination row
        End If
    Next c