Макрос для копирования-вставки между книгой данных и книгой печати

Question

Я довольно новичок в кодировании макросов в Excel VBA и мне нужна помощь.У меня есть 2 разные рабочие книги, с которыми я работаю.У одного есть наборы данных на нескольких листах, а у другого есть графики, которые соответствуют этим наборам данных.Я ищу макрос, который позволит мне скопировать столбцы DI из активного листа в книге данных и вставить его в активный лист в книге графиков.Самая сложная задача, которую я пытаюсь достичь, - я хочу, чтобы данные были вставлены в рабочую книгу на основе соответствующего столбца дат (столбец a в рабочей таблице и столбец b в рабочей таблице данных).

Причина2 книги - это шаблоны, и это самый простой способ, которым я смог придумать, чтобы все графики выглядели одинаково, за исключением различных данных.У меня есть более сотни таких графиков, поэтому все, что ускорит процесс передачи, будет с благодарностью.

Answer 1

Это должно работать.ПРИМЕЧАНИЕ. Убедитесь, что вы открываете каждую книгу только в 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