简体   繁体   中英

VBA Excel - Copy Rows to Another Workbook Sheet with conditions

Newbie trying to mix and match codes on an excel workbook that is configured to prompt a login and to allow diff Id and PW to see different sheets.

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

I have this challenge not being able to copy data from other workbook (a particular worksheet called 6-9months) to this workbook that I'm working on into Data Entry 1. The condition is to pick up all rows with the name "John" in Column I and paste to my active workbook sheet named "data entry 1". I attempted to activate the codes through a button click to pick up all the rows but it doesn't seem to work.

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

The essential problem with your code is that you are working with multiple Excel files at the same time (1) the file you are opening and searching for "John" and the (2) current file from which the macro is being called and to which we are importing the data. Yet, your code does not reference the two files but merely states to search for "john" in the ActiveSheet . Furthermore, you are not telling VBA in which of the two files you want to search the currently active sheet.

So, if you are working with multiple files then you should specifically address everything and don't ask VBA to make assumptions which file or which sheet or which cell on which sheet in which file you mean. Confused? If VBA would be a person then he/she would probably also be confused. Yet, VBA just makes assumptions and you are left to wonder why the code doesn't do what you expect it to do. Hence, when working with multiple files you should use the following explicit (!) references and tell VBA exactly what you want:

Workbooks("Book1.xlsx").Worksheets("Sheet1").Cells(1, 1).Value2

or

Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Value2

Having said that, I changed your code to make use of the above.

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

Note, that the above code is not an exact copy of yours. There are two changes:

(1) The sheet "Data Entry 2" in the current file (the file you are importing to) will be cleared without asking the user.

(2) The sheet "Data Entry 2" is directly referenced without the above check: if there actually is a sheet by that name in the current file.

So, don't forget to make the proper adjustments to suit your needs.

Do let me know if this solution works for you or if you have any more questions.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM