VBA Excel – 将行复制到具有条件的另一个工作簿表
新手试图混合并匹配excel工作簿上的代码，该工作簿被configuration为提示login并允许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月的特定工作表）复制到我正在处理数据input1的工作簿中。条件是拾取名为“John”的所有行，在列I中粘贴到我的活动工作簿表“数据input1”。 我试图通过点击button激活代码来拾取所有的行，但它似乎并没有工作。
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）打开的文件并search“John”和（2）当前正在调用该macros的文件，以及哪个我们正在导入数据。 然而，你的代码并没有引用这两个文件，只是声明在ActiveSheetsearch“john”。 而且，你并没有告诉VBA你想在哪个文件中search当前活动表单。
因此，如果您正在处理多个文件，那么您应该专门解决所有问题，而不要求VBA假设哪个文件或哪个表格或哪个表格中的哪个单元格表示哪个文件。 困惑？ 如果VBA是一个人，那么他/她也可能会感到困惑。 然而，VBA只是假设，你不知道为什么代码不会做你期望的事情。 因此，在使用多个文件时，应该使用下面的显式（！）引用，并告诉VBA究竟是什么：
Workbooks("Book1.xlsx").Worksheets("Sheet1").Cells(1, 1).Value2
要么
Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Value2
话虽如此，我改变了你的代码，以利用上述。
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）当前文件（正在导入的文件）中的“数据input2”表单将被清除而不询问用户。
（2）在没有上述检查的情况下直接引用“数据input2”表：如果当前文件中实际上存在该名称的表。
所以，不要忘记做适当的调整，以适应您的需求。
请让我知道这个解决scheme是否适合你，或者你还有什么问题。