建立巨集以複製資料並貼上到另一個工作簿

建立巨集以複製資料並貼上到另一個工作簿

我有兩本作業簿。其中一份是透過電子郵件發送的,其中有一個圖表,其中有一列填充了日期,即 10 年 11 月 1 日到 2010 年 11 月 30 日。當天圖表中填入了一行資料。

第二個工作簿有一個圖表,其中的一列也填入了日期。我需要幫助的是創建一個宏,該宏將查看工作簿2中的日期並將該日期與工作簿1相匹配,透過電子郵件發送,然後複製工作簿1中的資料行並將該行貼到具有相同日期的行上的工作簿2 。從未創建過宏,所以任何幫助將不勝感激

答案1

我想VLOOKUP在這種情況下,公式會比宏更容易。在列中填入公式後,執行複製和貼上。

在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 和/或儲存格的起始值物件(第一個值 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

相關內容