VBA Excel - 将行复制到具有条件的另一个工作簿 [英] VBA Excel - Copy Rows to Another Workbook Sheet with conditions

问题描述

新手试图混合并匹配一个配置为提示登录的excel工作簿中的代码，并允许diff ID和PW查看不同的表格。

 如果Me.userid.Value =admin和Me.userpw.Value =admin然后
 MsgBox登录成功！，vbInformation，登录提醒
 MsgBox 在任何情况下谨慎使用数据并保密，vbExclamation，Critical Reminder
 
卸载我
 
表格（汇总报表视图）可见= True 
 Sheets（Summary Report View）。选择
表格（数据验证）Visible = True 
表格（数据输入1）Visible = True 
表格（数据输入2）Visible = True 
表格（数据输入3）Visible = True 
  

我有这个挑战无法将数据从其他工作簿（特定工作表称为6-9个月）复制到我正在处理的数据输入1的工作簿中。条件是拾取列I中名称为John的所有行粘贴到我的活动工作簿表，名为数据条目1。我尝试通过按钮点击来启动代码，以接收所有行，但似乎不起作用。

 确认= MsgBox（你确定删除所有内容吗？这是不可逆的，vbYesNo，确认）
 
选择案例确认
案例是= vbYes 
 
表格（数据输入2）Cells.ClearContents 
 MsgBox信息已删除，vbInformation，信息
 
 Dim GCell As Range 
 Dim Txt $，MyPath $ ，MyWB $，MySheet $ 
 Dim myValue As String 
 Dim P As Integer，Q As Integer 
 Txt =John
 
 MyPath =C：\ 
 MyWB =Book1.xlsx
 
'MySheet = ActiveSheet.Name 
 
 Application.ScreenUpdating = False 
 
 Workbooks.Open文件名：= MyPath& MyWB 
 lastrow = ActiveSheet.Range（A& Rows.Count）.End（x1Up）.Row 
 For i = 2 To lastrow 
 
如果Cells（i，选择
 Selection.Copy 
 P = Worksheets.Count 
对于Q = 1到P 
如果ThisWorkbook.Worksheets（Q）.Name =数据条目2然后
工作表（数据条目2）。选择
 ThisWorkbook.Worksheets（Q）.Paste 
结束如果
下一个Q 
结束如果
下一个i 
 
 Case Is = vbNo 
 MsgBoxNo Changes Made，vbInformation，Information 
 
结束选择
  

解决方案

您的代码的基本问题是，您正在同时使用多个Excel文件（1）您打开的文件并搜索John和（2）正在调用宏的当前文件，并向其中我们正在导入数据。但是，您的代码不会引用这两个文件，而只是在 ActiveSheet 中搜索john。此外，您并没有告诉VBA您要搜索当前活动工作表的两个文件中的哪一个。

所以，如果你正在使用多个文件，那么你应该具体解决一切，不要求VBA假设哪个文件或哪个表单或哪个单元格在哪个文件中您的意思。困惑？如果VBA是一个人，那么他/她也许会被困惑。然而，VBA只是做出了假设，你不禁想知道为什么代码不能做你期望做的事情。因此，当使用多个文件时，您应该使用以下显式（！）引用，并告诉VBA您想要的内容：

工作簿（Book1 .xlsx）。工作表（Sheet1）。单元格（1，1）.Value2

或

工作簿（Book1.xlsx）工作表（Sheet1）。范围（A1）。Value2

说了这个，我改变了你的代码，以利用上面的内容。

 选项显式
 
 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或lOwEr个案无关紧要（正如当前设置） 
 strSearchString =jOHn
 strImportFile =Book1.xlsx
 
设置shtThisSheet = ThisWorkbook.Worksheets（数据条目2）
'如果导入文件与当前文件
'在同一个文件夹中，那么您也可以使用以下代码
'strPath = ThisWorkbook.Path 
 strPath =C：\tmp'C：用户\gary.tham\Desktop
 
带有应用程序
 .ScreenUpdating = False 
 .Calculation = xlCalculationManual 
 .EnableEvents = False 
 End With 
 
设置wbkImportFile = Workbooks.Open（文件名：= strPath& \& strImportFile）
'为了加快事情你也可以（如果可以的话）打开文件
'只读，而不更新链接到其他Excel文件（如果有）：
'设置wbkImportFile = Workbooks.Open（文件名：= strPath&\& strImportFile，ReadOnly：= True，UpdateLinks = = False）
设置shtImportSheet = wbkImportFile.Worksheets（6-9months）
 
 shtThisSheet.Cells.ClearContents 
对于lngrow = 2到shtImportSheet.Cells（shtImportSheet.Rows.Count，I）。End（xlUp）.Row 
如果InStr（1，shtImportSheet。 Cells（lngrow，I）。Value2，strSearchString，vbTextCompare）> 0然后
 shtImportSheet.Range（shtImportSheet.Cells（lngrow，1），shtImportSheet.Cells（lngrow，13））。复制
 shtThisSheet.Range（A& shtThisSheet.Cells（shtThisSheet.Rows .Count，A）。End（xlUp）.Row + 1）.PasteSpecial xlPasteAll，xlPasteSpecialOperationNone 
 End If 
 Next lngrow 
 
 wbkImportFile.Close SaveChanges：= False 
 
应用程序
 .ScreenUpdating = True 
 .Calculation = xlCalculationAutomatic 
 .EnableEvents = True 
结束
 
 End Sub 
  

请注意，上述代码不是您的精确副本。有两个变化：

（1）当前文件（要导入的文件）中的数据输入2表将被清除，而不要求用户。

（2）表格数据输入2在没有上述检查的情况下直接引用：如果在当前文件中实际上有该名称的表格。

所以，别忘了进行适当的调整以适应你的需要。

如果这个解决方案让我知道为您工作，或者您有任何其他问题。

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.

这篇关于VBA Excel - 将行复制到具有条件的另一个工作簿的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！