excel - 根据条件选择数据，然后根据与特定条件匹配的行复制行

Question

我有一个主文件，其中包含时隙及其各自的详细信息。 L 列标题为 "Slot Status" . A 列是从 1-1000 开始的唯一编号(例如 A2=1, A3=2, A3=4 ... )。

在 "UnSlotted"工作表，用户将更新信息以完成缺失的信息，这将导致 M 列中的单元格(插槽状态)从 "Info Required" 更改至"OK" .

我目前正在使用下面的宏来自动过滤包含“所需信息”的单元格的 L 列。然后它将找到的数据复制到标题为 "UnSlotted" 的工作表中。 .

我现在正在寻找一个宏，它将选择列 M 包含 "OK" 的行并将这些复制到"Master Sheet"在与相应唯一编号匹配的行上(A 列)。
例如。唯一编号 ID 为 "37" ，将此行复制到与 A 列唯一编号 ID 匹配的行中的工作表“主”。

Sub TestTHIS()

    Sheets("UnSlotted").Range("A6:M9999").Select
    Selection.ClearContents

    Dim ws As Worksheet
    Set ws = Application.Worksheets("Master File")

    Dim data_end_row_number As Integer
    data_end_row_number = ws.Range("a2").End(xlDown).Rows.Count

    ws.Range("A1:M1").AutoFilter field:=13, Criteria1:="Info required", VisibleDropDown:=True

    ws.Range("A2:M9999" & data_end_row_number).SpecialCells(xlCellTypeVisible).Copy
    Sheets("UnSlotted").Range("A6").PasteSpecial

    Worksheets("Master File").ShowAllData

End Sub

Answer 1

这会成功的。

您可能需要更改过滤(“确定”)应基于的列。现在它是工作表“UnSlotted”的 M 列。
您还可以更改应该复制多少行，(现在它是从 A 列到 AA。

VBA代码:

Sub CompareCopyFilter()

Dim CopyFromWorkbook As Workbook
Set CopyFromWorkbook = Workbooks("Master File.xlsm") 'Name the Workbook that should be copied from
Dim CopyToWorkbook As Workbook
Set CopyToWorkbook = Workbooks("Master File.xlsm") 'Name the Workbook that should be copied to
Dim CopyFromSheet As Worksheet
Set CopyFromSheet = CopyFromWorkbook.Worksheets("UnSlotted") 'Name the Worksheet that should be copied from
Dim CopyToSheet As Worksheet
Set CopyToSheet = CopyToWorkbook.Worksheets("Master File") 'Name the Worksheet that should be copied to
Dim lrow As Long
Dim lrowCompare As Long
Dim lrowPasteCopyTo As Long
Dim Val As String
Dim ValCompare As String
Dim j As Long
Dim Test As String
Dim Test2 As String

Dim cl As Range
Dim rng As Range
Dim CurrentRow As Long

lrow = CopyFromSheet.Cells(Rows.Count, "A").End(xlUp).Row 'Find last row in sheet that should be copied from
lrowCompare = CopyToSheet.Cells(Rows.Count, "A").End(xlUp).Row 'Find last row in sheet that should be copied from

CopyFromSheet.Activate 'Activate From Sheet
Set rng = CopyFromSheet.Range(Cells(2, 1), Cells(lrow, 1)) 'Set Range to apply filter on
CopyFromSheet.Range("A1:M1").AutoFilter Field:=13, Criteria1:="OK", VisibleDropDown:=True 'Filter Column M, based on criteria "OK" in the sheet you want to copy from

For Each cl In rng.SpecialCells(xlCellTypeVisible) 'Loop throug all visible cells in range
    CurrentRow = cl.Row 'Row number for current cell in filtered filter
    Val = CopyFromSheet.Cells(CurrentRow, "A").Value 'Get the value from the cell you want to copy from
    For j = 2 To lrowCompare 'Loop through the value in the sheet you want to copy to
        ValCompare = CopyToSheet.Cells(j, "A").Value 'Get the value from the cell you want to copy to
        If Val = ValCompare Then 'Compare the values between the two workbooks, if the match (exact match) then
            CopyFromSheet.Activate
            CopyFromSheet.Range(Cells(CurrentRow, "A"), Cells(CurrentRow, "AA")).Copy 'Copy row from Column A to Column AA
            CopyToSheet.Activate 'Activate workbook to paste into
            CopyToSheet.Range(Cells(j, "A"), Cells(j, "AA")).PasteSpecial xlPasteValues 'Paste values into range.
        End If
    Next j
Next cl
Application.CutCopyMode = False 'Deselect any copy selection
End Sub

我的示例设置是:

应从中复制的工作表。


应复制到的工作表。