Попытка скопировать определенные столбцы в строке в другой лист

Question

Я очень новичок в VBA. Попытка скопировать определенные столбцы в строке, если столбец O имеет текст «Открыть». Пробовал приведенный ниже код, и он работает, за исключением того, что он копирует всю строку, и я хочу только скопировать строку, но ограниченную столбцами с E по Q. Как вставить требование диапазона столбцов?

Sub Button2_Click()

    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("SheetA")
    Set Target = ActiveWorkbook.Worksheets("SheetB")

    j = 3     ' Start copying to row 3 in target sheet
    For Each c In Source.Range("O13:O1500")   ' Do 1500 rows
        If c = "Open" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
    Next c

End Sub

Answer 1

попробуй

 Source.Rows(c.Row).Columns("E:Q").Copy Target.Rows(j)

Вы должны иметь возможность использовать Union, чтобы собирать квалификационные диапазоны и вставлять за один раз, что будет более эффективным

Public Sub Button2_Click()
    Dim c As Range, unionRng As Range
    Dim Source As Worksheet, Target As Worksheet
    Set Source = ActiveWorkbook.Worksheets("SheetA")
    Set Target = ActiveWorkbook.Worksheets("SheetB")

    For Each c In Source.Range("O13:O1500")
        If c = "Open" Then
            If Not unionRng Is Nothing Then
                Set unionRng = Union(unionRng, Source.Rows(c.Row).Columns("E:Q"))
            Else
                Set unionRng = Source.Rows(c.Row).Columns("E:Q")
            End If
        End If
    Next c
    If Not unionRng Is Nothing Then unionRng.Copy Target.Range("A3")
End Sub

Answer 2

Во время копирования вы пытаетесь скопировать определенный диапазон. Поэтому вместо использования:

Source.Rows(c.Row).Copy Target.Rows(j)

Используйте

Source.Range("E*row*:Q*row*").Copy Target.Rows(j)

Где *row* - номер строки. Таким образом, вы можете скопировать Range из столбцов E в Q, сохранив фиксированный номер строки.

Итак, окончательный код

Sub Button2_Click()
Dim c As Range
Dim r As String 'Store the range here

Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet

' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("SheetA")
Set Target = ActiveWorkbook.Worksheets("SheetB")

j = 3     ' Start copying to row 3 in target sheet
For Each c In Source.Range("O10:O15")   ' Do 1500 rows
    If c = "Open" Then
        r = "E" & c.Row & ":" & "Q" & c.Row 'Creating the range
       Source.Range(r).Copy Target.Rows(j)
       j = j + 1
    End If
Next c
End Sub

Надеюсь, это поможет!

Answer 3

Intersect(Source.Rows(c.Row), Source.Range("E:Q")).Copy Target.Rows(j)

или

Source.Range("E:Q").Rows(c.Row).Copy Target.Rows(j)