VBA Excel - 使用條件將行復制到另一個工作簿表

Question

新手嘗試在 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-9months 的特定工作表）復制到我正在處理的數據條目 1 的工作簿中。條件是選擇名稱為“John”的所有行在第一列並粘貼到名為“數據條目 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

Answer 1

您的代碼的基本問題是您正在同時處理多個 Excel 文件 (1) 您正在打開並搜索“John”的文件和 (2) 從中調用宏的當前文件及其我們正在導入數據。 但是，您的代碼並未引用這兩個文件，而只是聲明要在ActiveSheet搜索“john”。 此外，您沒有告訴 VBA 要在兩個文件中的哪個文件中搜索當前活動的工作表。

因此，如果您正在處理多個文件，那么您應該專門解決​​所有問題，不要讓 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) 當前文件（您要導入的文件）中的“Data Entry 2”表將被清除而不詢問用戶。

(2) 直接引用“Data Entry 2”工作表，無需進行上述檢查：當前文件中是否確實存在該名稱的工作表。

因此，不要忘記進行適當的調整以滿足您的需求。

請告訴我此解決方案是否適合您，或者您還有其他問題。