VBA Excel-根据条件将行复制到另一个工作簿工作表

新手尝试混合和匹配excel工作簿上的代码，该工作簿配置为提示登录并允许diff Id和PW查看不同的工作表

If Me.userid.Value = "admin" And Me.userpw.Value = "admin" Then
MsgBox "Login Successful!", vbInformation, "Login Alert"
MsgBox "Entry and use data with caution and exercise confidentiality at all times!", vbExclamation, "Critical Reminder"

Unload Me

Sheets("Summary Report View").Visible = True
Sheets("Summary Report View").Select
Sheets("Data Validation").Visible = True
Sheets("Data Entry 1").Visible = True
Sheets("Data Entry 2").Visible = True
Sheets("Data Entry 3").Visible = True

我面临的挑战是无法将其他工作簿（称为6-9个月的特定工作表）中的数据复制到我正在处理的工作簿中的数据条目1中。条件是在列I中选择所有名为“John”的行，并粘贴到名为“data entry 1”的活动工作簿工作表中。我试图通过单击按钮来激活代码，以拾取所有行，但似乎不起作用

Confirmation = MsgBox("Are you sure to removal all contents? This is not reversible", vbYesNo, "Confirmation")

    Select Case Confirmation
    Case Is = vbYes

    Sheets("Data Entry 2").Cells.ClearContents
    MsgBox "Information removed", vbInformation, "Information"

    Dim GCell As Range
    Dim Txt$, MyPath$, MyWB$, MySheet$
    Dim myValue As String
    Dim P As Integer, Q As Integer
    Txt = "John"

    MyPath = "C:\Users\gary.tham\Desktop\"
    MyWB = "Book1.xlsx"

    'MySheet = ActiveSheet.Name

    Application.ScreenUpdating = False

    Workbooks.Open Filename:=MyPath & MyWB
    lastrow = ActiveSheet.Range("A" & Rows.Count).End(x1Up).Row
    For i = 2 To lastrow

    If Cells(i, 11) = txt Then
    Range(Cells(i, 1), Cells(i, 13)).Select
    Selection.Copy
    P = Worksheets.Count
    For Q = 1 To P
    If ThisWorkbook.Worksheets(Q).Name = "Data Entry 2" Then
    Worksheets("Data Entry 2").Select
    ThisWorkbook.Worksheets(Q).Paste
    End If
    Next Q
    End If
    Next i

    Case Is = vbNo
    MsgBox "No Changes Made", vbInformation, "Information"

    End Select

---

代码的基本问题是，您同时使用多个Excel文件（1）打开并搜索“John”的文件，以及（2）调用宏和导入数据的当前文件。然而，您的代码并没有引用这两个文件，只是声明在

ActiveSheet

中搜索“john”。此外，您没有告诉VBA要在两个文件中的哪个文件中搜索当前活动的图纸

因此，如果您正在处理多个文件，那么您应该明确地解决所有问题，不要要求VBA假设您指的是哪个文件、哪个工作表或哪个工作表上的哪个单元格、哪个文件中的哪个单元格。困惑的如果VBA是一个人，那么他/她可能也会感到困惑。然而，VBA只是做一些假设，让您想知道为什么代码没有达到您期望的效果。因此，在处理多个文件时，您应该使用以下明确的（！）引用，并准确地告诉VBA您想要什么：

工作簿（“Book1.xlsx”）。工作表（“Sheet1”）。单元格（1，1）。值2

或

工作簿（“Book1.xlsx”）。工作表（“Sheet1”）。范围（“A1”）。值2

话虽如此，我更改了您的代码以利用上述内容

Option Explicit

Sub CopyDataFromAnotherFileIfSearchTextIsFound()

Dim strPath As String
Dim wbkImportFile As Workbook
Dim shtThisSheet As Worksheet
Dim shtImportSheet As Worksheet

Dim lngrow As Long
Dim strSearchString As String
Dim strImportFile As String

'uPPer or lOwEr cases do not matter (as it is currently setup)
strSearchString = "jOHn"
strImportFile = "Book1.xlsx"

Set shtThisSheet = ThisWorkbook.Worksheets("Data Entry 2")
'If the import file is in the same folder as the current file
'   then you could also use the following instead
'strPath = ThisWorkbook.Path
strPath = "C:\tmp" '"C:Users\gary.tham\Desktop"

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With

Set wbkImportFile = Workbooks.Open(Filename:=strPath & "\" & strImportFile)
'To speed up things you could also (if acceptable) open the file
'   read-only without updating links to other Excel files (if there are any):
'Set wbkImportFile = Workbooks.Open(Filename:=strPath & "\" & strImportFile, ReadOnly:=True, UpdateLinks:=False)
Set shtImportSheet = wbkImportFile.Worksheets("6-9months")

shtThisSheet.Cells.ClearContents
For lngrow = 2 To shtImportSheet.Cells(shtImportSheet.Rows.Count, "I").End(xlUp).Row
    If InStr(1, shtImportSheet.Cells(lngrow, "I").Value2, strSearchString, vbTextCompare) > 0 Then
        shtImportSheet.Range(shtImportSheet.Cells(lngrow, 1), shtImportSheet.Cells(lngrow, 13)).Copy
        shtThisSheet.Range("A" & shtThisSheet.Cells(shtThisSheet.Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial xlPasteAll, xlPasteSpecialOperationNone
    End If
Next lngrow

wbkImportFile.Close SaveChanges:=False

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
End With

End Sub

请注意，上面的代码不是您的完全副本。有两个变化：

（1） 当前文件（您要导入的文件）中的工作表“数据输入2”将在不询问用户的情况下被清除

（2） 直接引用工作表“数据输入2”，而无需进行上述检查：如果当前文件中确实存在该名称的工作表

所以，别忘了做适当的调整以满足你的需要

---

请告诉我此解决方案是否适用于您，或者您是否还有其他问题。

@Ralph，非常感谢您的留言，我对此表示感谢。请务必理解，这不是一个代码编写服务，因为它更像是一个在代码错误上互相帮助的社区。我已经更新了正在使用的代码（“我在一系列网站和youtube上运行”）。。。抱歉，因为我对VBA不太熟悉。这些代码工作得非常好，我已经对其进行了修改，以适应更多的要求！非常感谢。我是否需要输入工作代码来更新问题，以便显示工作代码？不，一切都很好。您有一个问题，并且有一个答案（您已接受为适用的解决方案）。问题显示了你遇到的问题，答案显示了你问题的解决方案。像这样，这篇文章可能会在将来帮助其他人解决他们的问题。所以，一切都很好。但是谢谢你的邀请。如果您再次需要帮助，请不要犹豫，随时阅读其他用户的问题。也许你可以帮助他们解决问题？我会更经常地访问这个网站。就像你说的，也许我可以帮助别人。再次感谢@ralph