在数据工作簿和绘图工作簿之间复制粘贴的宏

时间:2019-01-23 16:29:38

标签: excel vba copy-paste

我在excel VBA中对宏进行编码还很陌生,我需要一些帮助。我正在使用2种不同的工作簿。一种是在多张纸上的数据集,另一种是与这些数据集对应的图。我正在寻找一个宏,该宏将允许我从数据工作簿的活动工作表中复制列D-I,并将其粘贴到绘图工作簿的活动工作表中。我想要实现的棘手部分是我希望基于相应的日期列(在绘图工作簿中的列a和在数据工作簿中的列b)将数据粘贴到绘图工作簿中。

使用这两个工作簿的原因是绘图是模板,这是我想出的最简单的方法,可以使所有绘图保持完全相同,除了各种数据。我有100多个这样的地块可以做,因此,任何能够加快转移过程的工作都将不胜感激。

1 个答案:

答案 0 :(得分:0)

这应该有效。 注意:确保只在1个Excel实例中打开每个工作簿。       例如:打开Dataworkbook.xls           从文件菜单中打开下一个工作簿           从文件菜单中打开下一个工作簿           等

以下是代码:

    Option Explicit

    'NOTE: This should be called from your main data Workbook
    Sub RunIT()

      '                             'Sheet that data is on
      '                                              'Range matrix to copy
      '                                                        'Workbook
      '                                                                     'Range to copy to
      DataPaste ThisWorkbook.Sheets("Sheet1").Range("C1:E10"), "Book1.xls", "E1"
      DataPaste ThisWorkbook.Sheets("Sheet1").Range("C1:E10"), "Book2.xls", "E1"

    End Sub

    Sub DataPaste(rngFrom As Range, strToWorkbook As String, strToRange As String)
        Dim shtSheet As Worksheet
        Dim wndw As Window
        Dim wbTo As Workbook
        Dim wbItem As Workbook

        'Initialize copy event
        rngFrom.Copy

        strToWorkbook = LCase(Trim(strToWorkbook))
        'loop through each workbook that is open in this instance of Excel
        For Each wbItem In Application.Workbooks
            'If Names match then, copy data
            If LCase(Trim(wbItem.Name)) = strToWorkbook Then
                'This loops through all sheets in specified workbook(CopyTo).
                For Each shtSheet In wbItem.Worksheets
                    'Paste it
                    shtSheet.Paste shtSheet.Range(strToRange)
                Next
            End If
        Next

    End Sub