Question

我有2个excel工作簿，每个工作簿都有2个选项卡，我想将数据仅从1个选项卡（每个工作簿）复制到另一个“主日志”工作簿中。这2个excel分别命名为“ Station 1 Daily Log”和“ Station 2 Daily Log”。这两个文件位于我的计算机的一个文件夹中。

我当前使用的代码将数据从每个工作簿的选项卡复制到相同的“主日志”选项卡，但是“第2站每日日志”取代了“第1站每日日志”数据。我的“主日志”工作簿包含2个标签：

为工作站名称“ FilesSheet”定义文件路径，文件名和选项卡的地方
我希望数据进入“ 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

我尝试了最后一行以及在网上找到的其他代码，但是它给了我范围误差等。或者它仅显示了Station 2的数据。

Answer 1

试试吧……我尽可能地重用了您的代码，但是在理想的情况下，您可以将其减少至少一半。我建议您在母版表中包含一些标题，仅清除标题下的内容，然后进行相应复制...

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

编辑：修复了第二个副本范围。

将2个Excel文件中的数据合并到一个主文件中

1 个答案: