Объединение данных из двух файлов Excel в один мастер-файл - PullRequest
1 голос
/ 23 мая 2019

У меня есть 2 книги Excel с 2 вкладками в каждой, и я хочу скопировать данные только с 1 вкладки (из каждой рабочей книги) в другую рабочую книгу "Основной журнал".Эти два номера называются «Ежедневник станции 1» и «Ежедневник станции 2».Эти 2 файла находятся в одной папке моего компьютера.

Код, который я сейчас использую, копирует данные из каждой вкладки рабочей книги в ту же вкладку «Основной журнал», но «Дневной журнал станции 2» заменяет »станция 1 ежедневник "данные.Моя рабочая книга «Основной журнал» состоит из 2 вкладок:

  1. , где путь к файлу, имя файла и вкладка определены для имени станции «FilesSheet»
  2. , где я хочуданные для ввода в «MasterSheet»

Я использовал lastrow, но он не работал, потому что я не знаю, где его разместить.

Sub UpdateMasterLog()
 Dim MainWorkbook As Workbook, Station1Workbook As Workbook, Station2Workbook As Workbook
 Dim FilesSheet As Worksheet, MasterSheet As Worksheet
 Dim InputFilePath As String, InputFileName As String, InputFileTab As String
 Dim rngToCopy As Range

Set MainWorkbook = ThisWorkbook
Set FilesSheet = Sheets("Files")
Set MasterSheet = Sheets("Master Log")

With FilesSheet
     InputFilePath = .Cells(1, 2)
     InputFileName = .Cells(2, 2)
     InputFileTab = .Cells(3, 2)
      .Cells(4, 2) = FileDateTime(InputFilePath + InputFileName)
 End With

 Set Station1Workbook = Workbooks.Open(InputFilePath + InputFileName)
 MasterSheet.Cells.ClearContents
 Station1Workbook.Sheets(InputFileTab).Cells.Copy Destination:=MasterSheet.Cells
 Station1Workbook.Close Savechanges:=False

 With FilesSheet
    InputFilePath = .Cells(5, 2)
    InputFileName = .Cells(6, 2)
    InputFileTab = .Cells(7, 2)
    .Cells(8, 2) = FileDateTime(InputFilePath + InputFileName)
 End With

 Set Station2Workbook = Workbooks.Open(InputFilePath + InputFileName)
 Station2Workbook.Sheets(InputFileTab).Cells.Copy Destination:=MasterSheet.Cells
 Station2Workbook.Close Savechanges:=False

End Sub

Я пытался в последней строкеи другие коды, которые я нашел в Интернете, но он давал мне ошибки диапазона и т. д., или он просто показывает только данные станции 2.

1 Ответ

0 голосов
/ 23 мая 2019

Попробуй ... я просто максимально использовал твой код, но в идеальном мире ты можешь уменьшить его как минимум до половины.Я рекомендую иметь несколько заголовков на вашем мастер листе, и только очистить под заголовками и копировать соответственно ...

Sub UpdateMasterLog()
    Dim MainWorkbook As Workbook: Set MainWorkbook = ThisWorkbook
    Dim Station1Workbook As Workbook, Station2Workbook As Workbook

    Dim FilesSheet As Worksheet: Set FilesSheet = MainWorkbook.Sheets("Files")
    Dim MasterSheet As Worksheet: Set MasterSheet = MainWorkbook.Sheets("Master Log")
    Dim wsSrc As Worksheet

    MasterSheet.Cells.ClearContents

    Dim InputFilePath As String, InputFileName As String, InputFileTab As String
    Dim rngToCopy As Range

    Dim lRowDst As Long, lRowSrc As Long, lColSrc As Long

    'Station1Workbook
    With FilesSheet
        InputFilePath = .Cells(1, 2)
        InputFileName = .Cells(2, 2)
        InputFileTab = .Cells(3, 2)
        .Cells(4, 2) = FileDateTime(InputFilePath + InputFileName)
    End With

    Set Station1Workbook = Workbooks.Open(InputFilePath + InputFileName)
    Set wsSrc = Station1Workbook.Sheets(InputFileTab)

    With MasterSheet
        lRowDst = 1 'if all clear should, last row is 1... ideally should have some headers and clear only under headers...

        With wsSrc
            lRowSrc = .Cells(.Rows.Count, 1).End(xlUp).Row
            lColSrc = .Cells(1, .Columns.Count).End(xlToLeft).Column
        End With

        'Allocate the values
        .Range(.Cells(lRowDst, 1), .Cells(lRowSrc, lColSrc)).Value = wsSrc.Range(wsSrc.Cells(1, 1), wsSrc.Cells(lRowSrc, lColSrc)).Value
    End With

    Station1Workbook.Close Savechanges:=False

    'Station2Workbook
    With FilesSheet
       InputFilePath = .Cells(5, 2)
       InputFileName = .Cells(6, 2)
       InputFileTab = .Cells(7, 2)
       .Cells(8, 2) = FileDateTime(InputFilePath + InputFileName)
    End With

    Set Station2Workbook = Workbooks.Open(InputFilePath + InputFileName)
    Set wsSrc = Station2Workbook.Sheets(InputFileTab)

    With MasterSheet
        lRowDst = .Cells(.Rows.Count, 1).End(xlUp).Row

        With wsSrc
            lRowSrc = .Cells(.Rows.Count, 1).End(xlUp).Row
            lColSrc = .Cells(1, .Columns.Count).End(xlToLeft).Column
        End With

        'Allocate the values
        .Range(.Cells(lRowDst + 1, 1), .Cells(lRowDst + lRowSrc, lColSrc)).Value = wsSrc.Range(wsSrc.Cells(2, 1), wsSrc.Cells(lRowSrc, lColSrc)).Value
    End With

    Station2Workbook.Close Savechanges:=False

End Sub

РЕДАКТИРОВАТЬ: фиксированные диапазоны второго копирования.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...