WBs to 1 sheet - date problem


New Member
Jun 7, 2012
[FONT=Arial, Helvetica, sans-serif]Hi

Hope someone can help....

I have adapted Jerry Beaucaire's "WBs to 1 sheet" merge function (see below) and all is working fine except that I am finding that when the data is imported some of the dates are being changed from UK to US format.

The workbooks to be imported have UK dates in column A in the format 13/08/2011 (ie 13th August 2011) and 12/08/2011 (ie 12th August 2011). The 13th August date imports correctly as 13/08/2011, but the 12th August date imports incorrectly as 08/12/2011 - changing it to the US date format which now translates as 8th December 2011 in the UK.


Sub Consolidate()
'Author:     Jerry Beaucaire'
'Date:       9/15/2009     (2007 compatible)
'Summary:    Open all Excel files in a specific folder and merge data
'            into one master sheet (stacked)
'            Moves imported files into another folder
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wbkNew As Workbook

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Set wbkNew = ThisWorkbook
    Sheets("Master").Activate   'sheet report is built into
    If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        NR = 1
        NR = Range("A" & Rows.Count).End(xlUp).Row + 1
    End If

'Path and filename (edit this section to suit)
    MsgBox "Please select a folder with files to consolidate"
        With Application.FileDialog(msoFileDialogFolderPicker)
            .AllowMultiSelect = False
            If .SelectedItems.Count > 0 Then
                fPath = .SelectedItems(1) & "\"
                Exit Do
                If MsgBox("No folder chosen, do you wish to abort?", _
                    vbYesNo) = vbYes Then Exit Sub
            End If
        End With
                  'remember final \ in this string
    fPathDone = fPath & "Imported\"     'remember final \ in this string
    On Error Resume Next
        MkDir fPathDone                 'creates the completed folder if missing
    On Error GoTo 0
    OldDir = CurDir                     'memorizes the users current working path
    ChDir fPath                         'activate the filepath with files to import
    fName = Dir("*.xls")                'listing of desired files, edit filter as desired

'Import a sheet from found file
    Do While Len(fName) > 0
        If fName <> wbkNew.Name Then     'make sure this file isn't accidentally reopened
        'Open file
            Set wbData = Workbooks.Open(fName)

        'This is the section to customize, replace with your own action code as needed
        'Find last row and copy data
    LR = Range("A" & Rows.Count).End(xlUp).Row
                          'copy the data only
                'If ws.Name <> "Sheet1" And ws.Name <> "Sheet2" And ws.Name <> "Sheet3" Then
                Range("A2:A" & LR).EntireRow.Copy _
                    wbkNew.Sheets("Master").Range("A" & NR)
    End If
        'close file
            wbData.Close False
        'Next row
            NR = Range("A" & Rows.Count).End(xlUp).Row + 1
        'move file to IMPORTED folder
            Name fPath & fName As fPathDone & fName
        'ready next filename
            fName = Dir
        'End If

ErrorExit:    'Cleanup
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
    ChDir OldDir                             'restores users original working path
End Sub
[FONT=Arial, Helvetica, sans-serif]

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
ok, figured it out. Added following code:

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
               fName, Destination:=Range("A1"))

etc etc.
Upvote 0

Forum statistics

Latest member
Stupid Idiot

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back