Visual Basic-Excel仅将一些列复制到其他工作表

有什么办法可以点击并复制一些列的某些值到其他工作表。

这张图片将会解释更多：

这是我的代码，但它有一些错误，我不知道为什么：

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上的列。 另外我会build议使用一个过程，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