Macro copies date into wrong format

[ditöle]

Dear experts,

I have a macro to merge txt files under ach other, but it copies the dates into a wrong format.

If it is 23/03/2000 (DD/MM/YY) is stays 23/03/2000 (DD/MM/YY)

But if it is 8/03/2000 (DD/MM/YY) it converts it into 8.3.2000

Is there a way to fix that?

I am using Excel 2011 on a Mac 10.6.8

Sub MergeCode2()
    Dim BaseWks As Worksheet
    Dim rnum As Long
    Dim CalcMode As Long
    Dim MySplit As Variant
    Dim FileInMyFiles As Long
    Dim Mybook As Workbook
    Dim sourceRange As Range
    Dim destrange As Range
    Dim SourceRcount As Long
    Dim FirstCell As String
    
'Add a new workbook with one sheet
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    BaseWks.Range("A1").Font.Size = 36
    BaseWks.Range("A1").Value = "Please Wait"
    rnum = 3
    
'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
'Clear MyFiles to be sure that it not return old info if no files are found
    MyFiles = ""
    
'Get the files, set the level of folders and extension in the code line below
    Call GetFilesOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=7, FileFilterOption:=0, FileNameFilterStr:="")
'Level                       :  1= Only the files in the folder you select, 2 to ? levels of subfolders
'ExtChoice               :  0=(xls|xlsx|xlsm|xlsb), 1=xls , 2=xlsx, 3=xlsm, 4=xlsb, 5=csv, 6=txt, 7=all files, 8=(xlsx|xlsm|xlsb), 9=(csv|txt)
'FileFilterOption     :  0=No Filter, 1=Begins, 2=Ends, 3=Contains
'FileNameFilterStr  : Search string used when FileFilterOption = 1, 2 or 3
    
' Work with the files if MyFiles is not empty.
    If MyFiles <> "" Then
        
        MySplit = Split(MyFiles, Chr(10))
        For FileInMyFiles = LBound(MySplit) To UBound(MySplit) - 1
            
            Set Mybook = Nothing
            On Error Resume Next
            Set Mybook = Workbooks.Open(MySplit(FileInMyFiles))
            On Error GoTo 0
            
            If Not Mybook Is Nothing Then
                
                On Error Resume Next
                
                With Mybook.Worksheets(1)
                    FirstCell = "A2"
                    Set sourceRange = .Range(FirstCell & ":" & RDB_Last(3, .Cells))
                    'Test if the row of the last cell is equal to or greater than the row of the first cell.
                    If RDB_Last(1, .Cells) < .Range(FirstCell).Row Then
                        Set sourceRange = Nothing
                    End If
                End With
                
                If Err.Number > 0 Then
                    Err.Clear
                    Set sourceRange = Nothing
                Else
                    'if SourceRange use all columns then skip this file
                    If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                        Set sourceRange = Nothing
                    End If
                End If
                On Error GoTo 0
                
                If Not sourceRange Is Nothing Then
                    
                    SourceRcount = sourceRange.Rows.Count
                    
                    If rnum + SourceRcount >= BaseWks.Rows.Count Then
                        MsgBox "Sorry there are not enough rows in the sheet"
                        BaseWks.Columns.AutoFit
                        Mybook.Close savechanges:=False
                        GoTo ExitTheSub
                    Else
                        
                        'Copy the file name in column A
                        With sourceRange
                            BaseWks.Cells(rnum, "A"). _
                            Resize(.Rows.Count).Value = MySplit(FileInMyFiles)
                        End With
                        
                        'Set the destrange
                        Set destrange = BaseWks.Range("B" & rnum)
                        
                        'we copy the values from the sourceRange to the destrange
                        With sourceRange
                            Set destrange = destrange. _
                            Resize(.Rows.Count, .Columns.Count)
                        End With
                        destrange.Value = sourceRange.Value
                        
                        rnum = rnum + SourceRcount
                    End If
                End If
                Mybook.Close savechanges:=False
            End If
            
            Next FileInMyFiles
            BaseWks.Columns.AutoFit
        End If
        
ExitTheSub:
        BaseWks.Range("A1").Value = "Ready"
        'Restore ScreenUpdating, Calculation and EnableEvents
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
            .Calculation = CalcMode
        End With
    End Sub

Thanks heaps!!
Stefan