Как я могу скопировать диапазон от листа к листу на основе значения столбца? - PullRequest
Новая
       11

Как я могу скопировать диапазон от листа к листу на основе значения столбца?

0 голосов
/ 15 января 2019

Я пытаюсь скопировать указанный диапазон ячеек с одного листа (Sheet2) в указанный диапазон ячеек на другом листе (Sheet1) на основе условия. Существуют сотни строк данных, и я хотел бы, чтобы код VBA просматривал каждую строку, и, если выполняется условие для этой строки, копирует указанный диапазон ячеек с sheet2 на sheet1. Копируется не вся строка, просто четыре ячейки из ряда с большим количеством ячеек, содержащих данные.

Если говорить более конкретно, я хотел бы скопировать столбцы с B по E для каждой строки (начиная со строки 2), ЕСЛИ значение в столбце AK для каждой строки больше 0. Я хотел бы, чтобы эти данные были вставлены в столбцы с B по E на листе 1, начиная со строки 8. Так, например, если строка 2 на листе 2 соответствует критериям, я бы хотел, чтобы от B2 до E2 на листе 2 были скопированы в B8 - E8 на листе 1.

Я пытался адаптировать код, найденный в других вопросах о StackOverFlow и других источниках, но я очень плохо знаком с VBA и не добился успеха. Любая помощь будет принята с благодарностью.

1 Ответ

0 голосов
/ 15 января 2019 
Private Sub CopySomeCells()
    Dim SourceSheet As Worksheet
    Dim DestinationSheet As Worksheet
    Dim SourceRow As Long
    Dim DestinationRow As Long

    Set SourceSheet = ActiveWorkbook.Sheets(2)
    Set DestinationSheet = ActiveWorkbook.Sheets(1)

    DestinationRow = 8
    For SourceRow = 2 To SourceSheet.UsedRange.Rows.Count
        If SourceSheet.Range("AK" & SourceRow).Value > 0 Then
            SourceSheet.Range(SourceSheet.Cells(SourceRow, 2), SourceSheet.Cells(SourceRow, 5)).Copy _
                DestinationSheet.Cells(DestinationRow, 2)
            DestinationRow = DestinationRow + 1
        End If
    Next SourceRow
    Application.CutCopyMode = False

    Set SourceSheet = Nothing
    Set DestinationSheet = Nothing
End Sub

Если вы просто хотите вставить значения (а не формат), измените две строки следующим образом: 

SourceSheet.Range(SourceSheet.Cells(SourceRow, 2), SourceSheet.Cells(SourceRow, 5)).Copy
DestinationSheet.Cells(DestinationRow, 2).PasteSpecial Paste:=xlPasteValues

Или лучше (быстрее и без буфера обмена): 

DestinationSheet.Cells(DestinationRow, 2).Resize(1, 4).Value = _
    SourceSheet.Cells(SourceRow, 2).Resize(1, 4).Value
...