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

Question

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

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

我遇到了这个挑战，无法将数据从其他工作簿（一个特定的工作sheet 称为 6-9 个月）复制到我正在处理的这个工作簿到数据输入 1。条件是选择第 I 列中名称为 "John" 的所有行，然后粘贴到名为 "data entry 1" 的活动工作簿 sheet。我试图通过单击按钮激活代码以选择所有行，但它似乎不起作用。

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 您要在两个文件中的哪个文件中搜索当前活动的 sheet.

因此，如果您正在处理多个文件，那么您应该专门解决所有问题，不要要求 VBA 假设哪个文件或哪个 sheet 或哪个单元格 sheet 你指的是哪个文件。使困惑？如果 VBA 是一个人，那么 he/she 可能也会感到困惑。然而，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) 当前文件（您要导入的文件）中的sheet "Data Entry 2" 将在不询问用户的情况下被清除。

(2) sheet "Data Entry 2" 被直接引用而不进行上述检查：如果当前文件中确实存在该名称的 sheet。

所以，不要忘记根据您的需要进行适当的调整。

如果此解决方案适合您或者您还有其他问题，请告诉我。

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

VBA Excel - Copy Rows to Another Workbook Sheet with conditions

excel

conditional

vba