Question

我有2个工作表。 sheet1是col A上的每月价值。Sheet 2是col A上的每日价值，我希望Excel在工作表2中（每日）查找相同的值，然后一旦找到确切的值，就从表1中复制匹配的行。（每月）并将其粘贴到工作表2（每天）中。有什么想法如何编写将自动执行此复制和粘贴值过程的VBA代码吗？（请参见屏幕截图） [1]：https://i.stack.imgur.com/G5LqW.png [在右侧，数据是每月（每月的最后一天），我需要匹配两张工作表的col A，然后将数据带到确切日期（该月的最后一天）的其他工作表上] [1]

Answer 1

未经测试

Sub Copy18()
Dim wb As Workbook
Dim wsD2 As worksheet, wsM2 As Worksheets
Dim LastRow As long, LastCol As Long, i as long
Dim Cell As Range, Rng As Range, SearchR As Range, CopyRng As Range, PasteRng As Range

Set wb = ThisWorkbook
Set wsD2 = wb.Sheets("Daily-2")
Set wsM2 = wb.Sheets("Monhly-2")

LastCol = wsM2.Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = wsM2.Cells(Rows.Count, 1).End(xlUp).Row

Set Rng = wsD2.Range(wsD2.Cells(1,1), wsD2.Cells(LastRow, LastCol))

For Each Cell in Rng
    Set SearchR = wsM2.Range("A:A").Find(Cell.Value, LookAt:=xlWhole)
    If Not SearchR Is Nothing Then
        i = LastCol = wsM2.Cells(SearchR.Row, Columns.Count).End(xlToLeft).Column
        Set CopyRng = wsM2.Range(wsM2.Cells(SearchR.Row, 1), wsM2.Cells(SearchR.Row, i))
        Set PasteRng = wsD2.Range(wsD2.Cells(LastRow + 1, 1), wsD2.Cells(LastRow + 1, i))
        PasteRng.Value = CopyRng.Value
        LastRow = LastRow + 1
    End If
Next Cell

End Sub

VBA，将行复制到不同的工作表，如果单元格值匹配到另一个工作表

1 个答案: