Excel WB.工作表（“时间记录”）.范围（“B5:N”和LastRow）.Font.Size=10 DestWB.工作表（“时间记录”）.Range（“K5:N”和LastRow）.NumberFormat=“#，##0.00” DestWB.工作表（“时间记录

WB.工作表（“时间记录”）.范围（“B5:N”和LastRow）.Font.Size=10 DestWB.工作表（“时间记录”）.Range（“K5:N”和LastRow）.NumberFormat=“#，##0.00” DestWB.工作表（“时间记录”）.范围（“K5:N”和LastRow）.水平对齐=xlCenter 如果结束 如果结束 以 退出 如果结束 下一个ws wb.Close savechanges:=False '文件夹中的下一个文件 excelfile=Dir 环 Application.CutCopyMode=False msg=MsgBox（“所有记录文件已合并”，vbInformation） 列（“B:N”）。自动拟合 端接头

Sub ConsolidateTimeRecording()

        Dim DestWB As Workbook
        Dim dR As Long
        Dim Fd As FileDialog
        Dim LastRow As Long
        Dim SourceSheet As String
        Dim sFile As String
        Dim sPath As String
        Dim StartRow As Long
        Dim wb As Workbook
        Dim ws As Worksheet

        Set DestWB = ActiveWorkbook

        SourceSheet = "Input"
        StartRow = 2

        Range("B4:N4").Select

        Selection.AutoFilter

           ' Select the folder that contains the files
        Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
            With Fd
                '.InitialFileName = "DefaultPath"
                    If .Show = -1 Then
                        sPath = Fd.SelectedItems(1) & "\"
                    End If
            End With
        Set Fd = Nothing
            ' Directory in the folder
            sFile = Dir(sPath)
            Do While sFile <> ""

            Set wb = Workbooks.Open(Filename:=sFile, ReadOnly:=True, Password:="master")
                For Each ws In wb.Worksheets
                    If ws.Name = SourceSheet Then
                        With ws
                            If .UsedRange.Cells.count > 1 Then
                                dR = DestWB.Worksheets("Time Recording").Range("B" & DestWB.Worksheets("Time Recording").Rows.count).End(xlUp).Row + 1
                                If dR < 5 Then dR = 6  'destination start row
                                    LastRow = .Range("A" & Rows.count).End(xlUp).Row
                                    If LastRow >= StartRow Then
                                        .Range("A" & StartRow & ":M" & LastRow).Copy
                                        DestWB.Worksheets("Time Recording").Cells(dR, "B").PasteSpecial xlValues
                                        DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Name = "Lucida Sans"
                                        DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Size = 10
                                        DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).NumberFormat = "#,##0.00"
                                        DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).HorizontalAlignment = xlCenter
                                    End If
                                End If
                        End With
                Exit For
            End If
        Next ws
        wb.Close savechanges:=False
        ' Next file in folder
        sFile = Dir
      Loop

        Application.CutCopyMode = False

        msg = MsgBox("All Time Recording files have been consolidated", vbInformation)

        Columns("B:N").AutoFit
    End Sub

Sub ConsolidateTimeRecording()

    Dim DestWB As Workbook
    Dim dR As Long
    Dim Fd As FileDialog
    Dim LastRow As Long
    Dim SourceSheet As String
    Dim sFile As String '****New line
    Dim sMidFile As String '****New line
    Dim StartRow As Long
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim excelfile As Variant

    Set DestWB = ActiveWorkbook

    SourceSheet = "Input"
    StartRow = 2

    Range("B4:N4").Select

    Selection.AutoFilter

    MidFile = InputBox("Please Enter The Month You Wish To Open")
    sFile = "D:\Work Files\" & MidFile & "\Time Recording\"

    excelfile = Dir(sFile & "*.xls")
    Do While excelfile <> ""

        Set wb = Workbooks.Open(Filename:=sFile & excelfile, ReadOnly:=True, Password:="master")
            For Each ws In wb.Worksheets
                If ws.Name = SourceSheet Then
                    With ws
                        If .UsedRange.Cells.count > 1 Then
                            dR = DestWB.Worksheets("Time Recording").Range("B" & DestWB.Worksheets("Time Recording").Rows.count).End(xlUp).Row + 1
                            If dR < 5 Then dR = 6  'destination start row
                                LastRow = .Range("A" & Rows.count).End(xlUp).Row
                                If LastRow >= StartRow Then
                                    .Range("A" & StartRow & ":M" & LastRow).Copy
                                    DestWB.Worksheets("Time Recording").Cells(dR, "B").PasteSpecial xlValues
                                    DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Name = "Lucida Sans"
                                    DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Size = 10
                                    DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).NumberFormat = "#,##0.00"
                                    DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).HorizontalAlignment = xlCenter
                                End If
                            End If
                    End With
            Exit For
        End If
    Next ws
    wb.Close savechanges:=False
    ' Next file in folder
        excelfile = Dir
    Loop

    Application.CutCopyMode = False

    msg = MsgBox("All Time Recording files have been consolidated", vbInformation)

    Columns("B:N").AutoFit
End Sub