Блог

Я должен скопировать диапазон данных из нескольких столбцов на основе совпадения имени ячейки с именем листа. Однако диапазон данных для каждого идентификатора в столбце «A» не одинаков, в случае некоторого совпадающего имени листа у нас есть 30 данных, а в некоторых случаях у нас может быть 20 данных или любое другое значение. Мой текущий код позволяет мне извлекать данные из листа «объединение» в листы шаблонов, имеющие совпадающее имя листа. Вместо извлечения 30 данных с использованием смещения из диапазона соответствия как я могу сделать код динамичным и извлечь данные на основе измененного имени листа в столбце A (после каждого имени скважины есть несколько пустых ячеек до следующего имени в столбце «A», которое необходимо учитывать при разработке кода VBA), скопировать данные, соответствующие этому имени, из столбцов M и S и вставить в листы шаблонов в столбцы E и G на основе совпадающего имени листа. В настоящее время я могу извлекать данные только из одного столбца, код необходимо динамически обновлять:

 Sub SPT()
Dim wkSht As Worksheet
Dim cell As Range

For Each cell In Sheets("Combine").Range("A5:A116").Cells

    For Each wkSht In ThisWorkbook.Worksheets
    
        If cell.Value = wkSht.Name Then
       
            Sheets("Combine").Range(cell.Offset(0, 12), cell.Offset(29, 12)).Copy wkSht.Range("G22")
        End If
    
    Next wkSht

Next cell
End Sub
 

Процесс копирования и вставки будет смещен в зависимости от значения ячейки Col H , пожалуйста, протестируйте и запустите его, спасибо:

 Sub SPT()
Dim wkSht As Worksheet
Dim cell As Range
Dim lastrow As Long, blankRow As Long, offsetRow As Long

lastrow = Sheets("Combine").UsedRange.Rows.Count

For Each cell In Sheets("Combine").Range("A2", "A" amp; lastrow).Cells

    For Each wkSht In ThisWorkbook.Worksheets
    
        If cell.Value = wkSht.Name Then
        
            If cell.End(xlDown).Row > lastrow Then
                blankRow = lastrow
            Else
                blankRow = cell.End(xlDown).Row - 1
            End If
            
            offsetRow = Application.WorksheetFunction.RoundDown(Sheet1.Cells(blankRow, 8).Value, 0)
            Sheets("Combine").Range(cell.Offset(0, 12), cell.Offset(offsetRow, 12)).Copy wkSht.Range("G22")
            Sheets("Combine").Range(cell.Offset(0, 18), cell.Offset(offsetRow, 18)).Copy wkSht.Range("E22")
        End If
    
    Next wkSht

Next cell
End Sub
 

Предположим, что ваше последнее имя листа в Col A строке 14, а ниже пустые данные

Когда вы используете сочетание клавиш ctrl down arrow key , оно перейдет в строку 1mil, так как я знаю , что такая ситуация произойдет, но я не хочу ее получать row 1mil , поэтому я установлю blankRow = lastrow(i.e. 20)