Question

Excel VBA初学者回来了。我正在创建一个执行以下两件事的宏：

1）在单个工作簿中搜索特定数据（名称）的多个工作表，下面的变量A 2）如果出现该名称，则将工作表中的特定范围的单元格（下面的变量X）复制到主文件（下面的变量B）

Sub Pull_X_Click()

Dim A As Variant 'defines name
Dim B As Workbook 'defines destination file
Dim X As Workbook 'defines existing report file as source
Dim Destination As Range 'defines destination for data pulled from report
Dim ws As Worksheet
Dim rng As Range

A = Workbooks("B.xlsm").Worksheets("Summary").Range("A1").Value
Set B = Workbooks("B.xlsm")
Set X = Workbooks.Open("X.xlsm")
Set Destination = Workbooks("B").Worksheets("Input").Range("B2:S2")

'check if name is entered properly
If A = "" Then
MsgBox ("Your name is not visible; please start from the Reference tab.")
Worksheets("Reference").Activate
Exit Sub
End If

X.Activate


For Each ws In X.Worksheets
  Set rng = ws.Range("A" & ws.Rows.Count).End(xlUp)
  If InStr(1, rng, A) = 0 Then
Else
    X.ActiveSheet.Range("$A$2:$DQ$11").AutoFilter Field:=1, Criteria1:=A
    Range("A7:CD7").Select
    Selection.Copy
    Destination.Activate
    Destination.PasteSpecial
End If
Next ws

Application.ScreenUpdating = False

End Sub

UPDATE ：我设法解决了以前的编译错误，似乎代码（应该？）有效。然而，它走到了这一步：

X.Activate

......然后什么都没发生。没有运行时错误或任何东西，但它似乎没有搜索文件（变量X）或根据变量A的存在拉动任何数据。任何想法？

Answer 1

我要做的是循环遍历行并评估出现必要数据的列，然后避免复制/粘贴，只需使目标范围等于源范围：

Sub SearchNCopy()

Dim A As String 'The String you are searching for
Dim b As String ' the string where you shall be searching
Dim wbs, wbt As Workbook ' Declare your workbooks
Dim wss As Worksheet
Dim i, lrow As Integer

Set wbt = Workbooks("B.xlsm") 'Set your workbooks
Set wbs = Workbooks.Open("X.xlsm")


A = wbt.Worksheets("Summary").Range("A1").Value

If A = "" Then
    MsgBox ("Your name is not visible; please start from the Reference tab.")
    Worksheets("Reference").Activate
    Exit Sub
End If

For Each wss In wbs.Worksheets 'Loop through sheets

    lrow = wss.Cells(wss.Rows.Count, "A").End(xlUp).Row 'Find last used row in each sheet - MAKE SURE YOUR SHEETS DONT HAVE BLANKS BETWEEN ENTIRES

        For i = 1 To lrow Step 1 'Loop through the rows

            b = wss.Range("A" & i).Value 'Assign the value to the variable from column a of the row

                If Not InStr(1, b, A) = 0 Then 'Evaluate the value in the column a and if it contains the input string, do the following

                    wbt.Worksheets("Input").Range("B2:CC2") = wss.Range("A" & i & ":CD" & i) 'copies the range from one worksheet to another avoiding copy/paste (much faster)

                End If

            Next i

Next wss

End Sub

编译错误：搜索一个特定数据点，循环遍历整个工作簿，复制/粘贴数据

1 个答案: