☰

创建宏以复制数据并粘贴到另一个工作簿

tag-icon • tag-icon microsoft-excel vba
创建宏以复制数据并粘贴到另一个工作簿

我有两本工作簿。一本通过电子邮件发送，其中有一个图表，其中有一列填充了日期，即 11/01/10 至 11/30/10。对于那一天，图表填充了一行数据。

第二个工作簿有一个图表，其中有一列也填充了日期。我需要帮助的是创建一个宏，该宏将查看工作簿 2 中的日期并将该日期与工作簿 1 进行匹配，通过电子邮件发送，然后从工作簿 1 复制数据行并将该行粘贴到工作簿 2 中具有相同日期的行。从未创建过宏，因此任何帮助都将不胜感激

答案1

我认为VLOOKUP在这种情况下公式比宏更容易。在列中填写公式后，执行 COPY & PASTE.Values 以删除公式。

在 VLOOKUP 示例中编辑： 您需要制作一个表格，将工作簿中的日期与通过电子邮件发送的工作簿中的日期相同。调整以下内容以适合您的情况

A1 = 是从您想要在电子邮件中获取值的表中查找的值（日期？）
[Example.xlsx] = 是您通过电子邮件发送的工作簿的名称
Sheet1！= 包含数据表的电子邮件工作簿中的电子表格的名称
$A$1:$B$30 = 通过电子邮件发送的工作簿中数据的完整范围
2 = 我们要从中获取返回值的数据范围中的列（A 和 B 中的第 2 列）
FALSE = 我们希望查找值与电子邮件数据中的值完全匹配

=VLOOKUP(A1,[Example.xlsx]Sheet1!$A$1:$B$30,2,FALSE)

但是，为了简单起见，如果您不介意将一个工作簿保留为接收数据的模板，那么以下方法将有效。只需将其放入模板工作簿的模块并保存即可。当您收到新电子邮件时，请打开模板，打开电子邮件工作簿，然后从电子邮件工作簿激活宏

代码中的假设：
1：在通过电子邮件发送的工作簿中，数据从单元格 A1 开始
2：在宏/模板工作簿中，数据从单元格 A1 开始
如果这些假设中的任何一个不正确，则调整 L1 和/或 Cells 对象的起始值（第一个值 L1 是行，第二个数字是列；A = 1）

Sub CopyData()
    Dim All As New Collection
    Dim One As Variant, L1 As Integer, L2 As Integer
    Dim TW As Workbook, EW As Workbook

    Set TW = ThisWorkbook
    Set EW = ActiveWorkbook

    L1 = 15
    Do Until Cells(L1, 2).Value = ""
        ReDim One(0 To 1)
        One(0) = Cells(L1, 2).Value
        One(1) = Cells(L1, 3).Value
        All.Add One
        Erase One
        L1 = L1 + 1
    Loop

    TW.Activate
    L1 = 15
    Do Until Cells(L1, 2).Value = ""
        For L2 = 1 To All.Count
            One = All(L2)
            If One(0) = Cells(L1, 2).Value Then
                Cells(L1, 3).Value = One(1)
                Erase One
                Exit For
            Else
                Erase One
            End If
        Next L2
        L1 = L1 + 1
    Loop
End Sub

相关内容