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)

您应该能够使用联盟来收集排位赛范围并一键粘贴，这样会更有效率

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从列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

希望这会有所帮助！

尝试将一行中的特定列复制到另一个工作表中

3 个答案: