嘗試將一行中的特定列復制到另一個工作表中

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

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

要么

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

Answer 2

嘗試

 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 3

復制時，您正在嘗試復制特定范圍。 因此，不要使用：

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

采用

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

其中*row*是行號。 因此，您可以將E從列復制到列，同時保持行號固定。

所以最終的代碼是

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

希望這可以幫助 ！