Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vVal
    Dim StrVal As String
    Dim dDate As Date
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("F5:AJ50,AR5:AS50")) Is Nothing Then
        With Target
            vVal = Format(.Value, "0000")
            If IsNumeric(vVal) And Len(vVal) = 5 Then
                Application.EnableEvents = False
                .Value = Left(vVal, 3) & ":" & Right(vVal, 2)
                .NumberFormat = "[h]:mm"
                Else
                Application.EnableEvents = False
                .Value = Left(vVal, 2) & ":" & Right(vVal, 2)
                .NumberFormat = "[h]:mm"
            End If
        End With
    End If
    Application.EnableEvents = True
End Sub

vVal = Format(.Value, "00000")
If IsNumeric(vVal) And Len(vVal) = 5 Then

.Value = Left(vVal, 3) & ":" & Right(vVal, 2)

Sub CombineWorkbooks()
    Dim FilesToOpen
    Dim x As Integer
 
    Application.ScreenUpdating = False  'отключаем обновление экрана для скорости
     
    'вызываем диалог выбора файлов для импорта
    FilesToOpen = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", MultiSelect:=True, Title:="Files to Merge")
 
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Не выбрано ни одного файла!"
        Exit Sub
    End If
     
    'проходим по всем выбранным файлам
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
    
        For i = 1 To importWB.Sheets.Count
            If Not (WorksheetFunction.CountA(importWB.Sheets(i).UsedRange) = 0) Then
                importWB.Sheets(i).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
               
 ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = 
Left(importWB.Name, InStr(importWB.Name, ".") - 1) + "_" + 
importWB.Sheets(i).Name
            End If
        Next i
        importWB.Close savechanges:=False
        x = x + 1
    Wend
 
    Application.ScreenUpdating = True
End Sub