Visual Basic-Excel仅将某些列复制到另一个工作表

Question

有没有办法点击并将某些列的某些值复制到其他工作表。

这张照片将解释更多：

这是我的代码，但它有一些我不知道原因的错误：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sheets("SheetB").Select
    ' Find the last row of data
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    ' Loop through each row
    For x = 1 To FinalRow
        ' Decide if to copy based on column A in sheetB
        ThisValue = Cells(x, 1).Value
        If ThisValue = Target.Value Then
            Cells(x, 1).Resize(1, 33).Copy
            Sheets("SheetC").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("SheetB").Select
         End If
    Next x

End Sub

Answer 1

尝试以下代码：

在运行代码之前，请先在表B上的列中添加标题。另外我建议使用一个Worksheet_SelectionChange事件的过程。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Application.EnableEvents = False
    On Error Resume Next

    Dim rngFind As Range
    Dim firstCell As String
    Dim i As Integer

    If Target.Column = 1 & Target.Value <> "" Then

        Set rngFind = Sheets("SheetB").Columns(1).Find(What:=Target.Value, LookIn:=xlValues, LookAt:=xlWhole, Searchorder:=xlByRows)

        If Not rngFind Is Nothing Then firstCell = rngFind.Address

        i = 1
        Do While Not rngFind Is Nothing

            Sheets("sheetC").Cells(i, 1).Value = rngFind
            Sheets("sheetC").Cells(i, 2).Value = rngFind.Offset(0, 1)
            Sheets("sheetC").Cells(i, 3).Value = Target.Offset(0, 1)

            i = i + 1
            Set rngFind = Sheets("SheetB").Columns(1).FindNext(rngFind)
            If rngFind.Address = firstCell Then Exit Do
        Loop
    End If

    Application.EnableEvents = True
End Sub