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



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

2 个工作簿的原因是绘图是一个模板,这是我能够想到的最简单的方法,可以保持除各种数据外的所有绘图看起来完全相同。我有一百多个这样的地块可以做,所以任何能加快转移过程的东西都将不胜感激。

这应该有效。注意: 请确保仅在 1 个 Excel 实例中打开每个工作簿。 例如:打开数据工作簿.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

相关内容

  • 没有找到相关文章