Import Data - Receiving "extension don't match"

Carin

Board Regular
Joined
Feb 4, 2006
Messages
224
I'm attempting for the first time to get multiple files from a folder to append into one file. The data format is old "Microsoft Excel 97-2003 Worksheet." When just manually opening one file I receive "The file format and extension of 'file name.xls' don't match. The file could be corrupted or unsafe. Unless you trust it's source, don't open it. Do you want to open it anyway?" After opening if I try to change the file extension, the current format is "Text (Tab delimited)(*.txt)"
If I try to just simply change the extension, I receive an error while importing that the data is corrupt. If I open each file one-by-one and change the format and file extension, then I can import. Is there a faster way as I have >100 files to perform this task on a weekly basis. Thank you.
 

KRice

Well-known Member
Joined
Dec 9, 2003
Messages
1,133
Office Version
  1. 2019
Platform
  1. Windows
Carin, I missed something in my commentary above. I inserted a backslash in the assignment for XlFolder, but it should be omitted as the backslash is already accounted for in the .SaveAs Filename lines. More importantly, I'm not sure the code will do what you want. You mentioned "get multiple files from a folder to append into one file." I'm assuming the multiple files have a very similar structure. Is it your intention to append by row, or by column?

For example, if testfile1 is...
MrExcel20210203_Carin.xlsx
AB
1a1
2b2
3c3
testfile1

and testfile2 is...
MrExcel20210203_Carin.xlsx
ABC
1d47
2e58
3f69
testfile2


Is this what the final product should look like...appended by row?
MrExcel20210203_Carin.xlsx
ABC
1
2Appended file results
3a1
4b2
5c3
6d47
7e58
8f69
Consolidate_Data


Or are you looking for a final product like this...appended by column?
MrExcel20210203_Carin.xlsx
ABCDE
1
2a1d47
3b2e58
4c3f69
Append_Data


The above were done with three sets of code:
1) one consolidates multiple .xls, .xlsx., and .xlsm files into one workbook, with each worksheet taking the name of its source workbook. The user is given a file explorer window to navigate to and select the multiple files that should be incorporated into the working Workbook.
2) another operates on all worksheets in the working Workbook and appends all sheets by column
3) another operates on all worksheets in the working Workbook and appends all sheets by row
For convenience, I named the top level worksheet "Carin" and placed the three sets of VBA code in separate modules of that sheet. Then the first code is run (MergeExcelFiles), selecting which files should be added to the workbook. Then either 2 or 3 are run to append by column or row, and a new sheet is created with the appended/consolidated content. Because the latter two VBA codes use all of the sheets in the workbook, you won't want to run both (2 and 3) in the same session.

VBA Code:
' VBA code below sourced from...
' https://www.ablebits.com/office-addins-blog/2017/11/08/merge-multiple-excel-files-into-one/#combine-Excel-files-VBA

Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook
 
    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
 
    If (vbBoolean <> VarType(fnameList)) Then
 
        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0
 
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
 
            Set wbkCurBook = ActiveWorkbook
 
            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1
 
                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
 
                For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1
                    wksCurSheet.Copy After:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                Next
 
                wbkSrcBook.Close SaveChanges:=False
 
            Next
 
            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
 
            MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If
 
    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub

VBA Code:
' Below VBA sourced from...
' https://analysistabs.com/vba-code/excel-projects/append-data-from-multiple-worksheets-column/

Sub Append_Data_From_Different_Sheets_Into_Single_Sheet_By_Column()
'Procedure to Consolidate all sheets in a workbook

On Error GoTo IfError

'1. Variables declaration
Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstCol As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range

'2. Disable Screen Updating - stop screen flickering
'   And Disable Events to avoid inturupted dialogs / popups
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'3. Delete the Append_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Append_Data").Delete
Application.DisplayAlerts = True

'4. Add a new WorkSheet and name as 'Append_Data'
With ActiveWorkbook
    Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    DstSht.Name = "Append_Data"
End With

'5. Loop through each WorkSheet in the workbook and copy the data to the 'Append_Data' WorkSheet
For Each Sht In ActiveWorkbook.Worksheets
    If Sht.Name <> DstSht.Name Then
       '5.1: Find the last row on the 'Append_Data' sheet
       DstCol = fn_LastColumn(DstSht)
           
       If DstCol = 1 Then DstCol = 0
               
       '5.2: Find Input data range
       LstRow = fn_LastRow(Sht)
       LstCol = fn_LastColumn(Sht)
       EnRange = Sht.Cells(LstRow, LstCol).Address
       Set SrcRng = Sht.Range("A1:" & EnRange)
       
       '5.3: Check whether there are enough columns in the 'Append_Data' Worksheet
        If DstCol + SrcRng.Columns.Count > DstSht.Columns.Count Then
            MsgBox "There are not enough columns to place the data in the Append_Data worksheet."
            GoTo IfError
        End If
                
      '5.4: Copy data to the 'Append_Data' WorkSheet
        SrcRng.Copy Destination:=DstSht.Cells(2, DstCol + 1)
    End If
Next
DstSht.Range("A1") = "You can place the heading in the first column"

IfError:
'6. Enable Screen Updating and Events
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub


'In this example we are finding the last Row of specified Sheet
'In this example we are finding the last Row of specified Sheet
Function fn_LastRow(ByVal Sht As Worksheet)

    Dim lastRow As Long
    lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
    lRow = Sht.Cells.SpecialCells(xlLastCell).Row
    Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
        lRow = lRow - 1
    Loop
    fn_LastRow = lRow

End Function

'In this example we are finding the last column of specified Sheet
Function fn_LastColumn(ByVal Sht As Worksheet)

    Dim lastCol As Long
    lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
    lCol = Sht.Cells.SpecialCells(xlLastCell).Column
    Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
        lCol = lCol - 1
    Loop
    fn_LastColumn = lCol

End Function


VBA Code:
' VBA below sourced from...
' https://analysistabs.com/vba-code/excel-projects/consolidate-data-from-multiple-worksheets-row/

Sub Consolidate_Data_From_Different_Sheets_Into_Single_Sheet_by_Row()
'Procedure to Consolidate all sheets in a workbook

On Error GoTo IfError

'1. Variables declaration
Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstRow As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range

'2. Disable Screen Updating - stop screen flickering
'   And Disable Events to avoid inturupted dialogs / popups
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'3. Delete the Consolidate_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete
Application.DisplayAlerts = True

'4. Add a new WorkSheet and name as 'Consolidate_Data'
With ActiveWorkbook
    Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    DstSht.Name = "Consolidate_Data"
End With

'5. Loop through each WorkSheet in the workbook and copy the data to the 'Consolidate_Data' WorkSheet
For Each Sht In ActiveWorkbook.Worksheets
    If Sht.Name <> DstSht.Name Then
       '5.1: Find the last row on the 'Consolidate_Data' sheet
       DstRow = fn_LastRow(DstSht) + 1
               
       '5.2: Find Input data range
       LstRow = fn_LastRow(Sht)
       LstCol = fn_LastColumn(Sht)
       EnRange = Sht.Cells(LstRow, LstCol).Address
       Set SrcRng = Sht.Range("A1:" & EnRange)
       
       '5.3: Check whether there are enough rows in the 'Consolidate_Data' Worksheet
        If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
            MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
            GoTo IfError
        End If
                
      '5.4: Copy data to the 'consolidated_data' WorkSheet
        SrcRng.Copy Destination:=DstSht.Range("A" & DstRow)
                
    End If

Next

IfError:

'6. Enable Screen Updating and Events
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

'In this example we are finding the last Row of specified Sheet
Function fn_LastRow(ByVal Sht As Worksheet)

    Dim lastRow As Long
    lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
    lRow = Sht.Cells.SpecialCells(xlLastCell).Row
    Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
        lRow = lRow - 1
    Loop
    fn_LastRow = lRow

End Function

'In this example we are finding the last column of specified Sheet
Function fn_LastColumn(ByVal Sht As Worksheet)

    Dim lastCol As Long
    lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
    lCol = Sht.Cells.SpecialCells(xlLastCell).Column
    Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
        lCol = lCol - 1
    Loop
    fn_LastColumn = lCol

End Function
 
Solution

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Carin

Board Regular
Joined
Feb 4, 2006
Messages
224
Krice - WOW!

I did have to add the green lines below. I REALLY like the ability to to pull all the files into separate sheets then merging (appending) them together based on column. Is there ANYWAY for it not to include a particular sheet? If not, not a big deal I can work with this nicely. Thank you.

Dim lastCol As Long
Dim lCol As Long
lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
lCol = Sht.Cells.SpecialCells(xlLastCell).Column


Dim lastRow As Long
Dim lRow As Long
lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
lRow = Sht.Cells.SpecialCells(xlLastCell).Row
 

Carin

Board Regular
Joined
Feb 4, 2006
Messages
224
select your Folder press "Shift" Button Right Mouse copy "Path"

XlFolder = "then paste here\"

as KRice advice
XlFolder = "C:\Users\FH8400\OneDrive - USPS\Carin's work spreadsheets\Bossio\Outlook Attachments\"

Forget Environ("USERPROFILE")
I am still getting the compile error. I can use KRice's code. I wanted to thank you for taking the time to help me out. Much appreciated.
 

KRice

Well-known Member
Joined
Dec 9, 2003
Messages
1,133
Office Version
  1. 2019
Platform
  1. Windows
I'm glad this is working for you...and good catch on the variable declarations. For some reason, my system did not throw any errors.

About your other question, it sounds as if you have at least one worksheet in the compilation workbook that you would like to exclude from the append operations. How many worksheets would you like to exclude?
 

Carin

Board Regular
Joined
Feb 4, 2006
Messages
224

ADVERTISEMENT

Yes, I do and one sheet.
 

KRice

Well-known Member
Joined
Dec 9, 2003
Messages
1,133
Office Version
  1. 2019
Platform
  1. Windows
Give this a try...you'll enter the exact name of the worksheet that should be excluded between quotes near the top of the code listing. If I understand correctly, you're interesting in the append by Column version of the code. Similar modifications could be made to the "by Row" version if needed.

VBA Code:
' Below VBA sourced from...
' https://analysistabs.com/vba-code/excel-projects/append-data-from-multiple-worksheets-column/
' and modified to exclude a user-specified worksheet

Sub Append_Data_From_Different_Sheets_Into_Single_Sheet_By_Column()
'Procedure to Consolidate all sheets in a workbook

On Error GoTo IfError

'0. User specifies name of worksheet to exclude from append operation
Dim ExcludeSht As String
    ExcludeSht = "test Exclude"       '<<<<< Enter worksheet name to exclude >>>>>

'1. Variables declaration
Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstCol As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range

'2. Disable Screen Updating - stop screen flickering
'   And Disable Events to avoid inturupted dialogs / popups
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'3. Delete the Append_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Append_Data").Delete
Application.DisplayAlerts = True

'4. Add a new WorkSheet and name as 'Append_Data'
With ActiveWorkbook
    Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    DstSht.Name = "Append_Data"
End With

'5. Loop through each WorkSheet in the workbook and copy the data to the 'Append_Data' WorkSheet
For Each Sht In ActiveWorkbook.Worksheets
    
    If ((Sht.Name <> DstSht.Name) And (Sht.Name <> ExcludeSht)) Then
       '5.1: Find the last row on the 'Append_Data' sheet
       DstCol = fn_LastColumn(DstSht)
           
       If DstCol = 1 Then DstCol = 0
               
       '5.2: Find Input data range
       LstRow = fn_LastRow(Sht)
       LstCol = fn_LastColumn(Sht)
       EnRange = Sht.Cells(LstRow, LstCol).Address
       Set SrcRng = Sht.Range("A1:" & EnRange)
       
       '5.3: Check whether there are enough columns in the 'Append_Data' Worksheet
        If DstCol + SrcRng.Columns.Count > DstSht.Columns.Count Then
            MsgBox "There are not enough columns to place the data in the Append_Data worksheet."
            GoTo IfError
        End If
                        
      '5.4: Copy data to the 'Append_Data' WorkSheet
        SrcRng.Copy Destination:=DstSht.Cells(2, DstCol + 1)
    
    End If
    
Next

DstSht.Range("A1") = "You can place the heading in the first column"

IfError:
'6. Enable Screen Updating and Events
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub


'In this example we are finding the last Row of specified Sheet
Function fn_LastRow(ByVal Sht As Worksheet)

    Dim lastRow As Long
    Dim lRow As Long
    lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
    lRow = Sht.Cells.SpecialCells(xlLastCell).Row
    Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
        lRow = lRow - 1
    Loop
    fn_LastRow = lRow

End Function


'In this example we are finding the last column of specified Sheet
Function fn_LastColumn(ByVal Sht As Worksheet)

    Dim lastCol As Long
    Dim lCol As Long
        lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
    lCol = Sht.Cells.SpecialCells(xlLastCell).Column
    Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
        lCol = lCol - 1
    Loop
    fn_LastColumn = lCol

End Function
 

Carin

Board Regular
Joined
Feb 4, 2006
Messages
224

ADVERTISEMENT

Works very well. I tried adding the '0 code to the "Consolidate_Data" code and it didn't work.
 

KRice

Well-known Member
Joined
Dec 9, 2003
Messages
1,133
Office Version
  1. 2019
Platform
  1. Windows
There is one additional tweak needed in section 5 of the code where the IF statement checks to see if the next worksheet name matches the excluded sheet name. The version below should work...I think.

VBA Code:
' VBA below sourced from...
' https://analysistabs.com/vba-code/excel-projects/consolidate-data-from-multiple-worksheets-row/
' and modified to exclude a user-specified worksheet

Sub Consolidate_Data_From_Different_Sheets_Into_Single_Sheet_by_Row()
'Procedure to Consolidate all sheets in a workbook

On Error GoTo IfError

'0. User specifies name of worksheet to exclude from append operation
Dim ExcludeSht As String
    ExcludeSht = "test Exclude"       '<<<<< Enter worksheet name to exclude >>>>>

'1. Variables declaration
Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstRow As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range

'2. Disable Screen Updating - stop screen flickering
'   And Disable Events to avoid inturupted dialogs / popups
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'3. Delete the Consolidate_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete
Application.DisplayAlerts = True

'4. Add a new WorkSheet and name as 'Consolidate_Data'
With ActiveWorkbook
    Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    DstSht.Name = "Consolidate_Data"
End With

'5. Loop through each WorkSheet in the workbook and copy the data to the 'Consolidate_Data' WorkSheet
For Each Sht In ActiveWorkbook.Worksheets
    If ((Sht.Name <> DstSht.Name) And (Sht.Name <> ExcludeSht)) Then
       '5.1: Find the last row on the 'Consolidate_Data' sheet
       DstRow = fn_LastRow(DstSht) + 1
               
       '5.2: Find Input data range
       LstRow = fn_LastRow(Sht)
       LstCol = fn_LastColumn(Sht)
       EnRange = Sht.Cells(LstRow, LstCol).Address
       Set SrcRng = Sht.Range("A1:" & EnRange)
       
       '5.3: Check whether there are enough rows in the 'Consolidate_Data' Worksheet
        If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
            MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
            GoTo IfError
        End If
                
      '5.4: Copy data to the 'consolidated_data' WorkSheet
        SrcRng.Copy Destination:=DstSht.Range("A" & DstRow)
                
    End If

Next

IfError:

'6. Enable Screen Updating and Events
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

'In this example we are finding the last Row of specified Sheet
Function fn_LastRow(ByVal Sht As Worksheet)

    Dim lastRow As Long
    Dim lRow As Long
    lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
    lRow = Sht.Cells.SpecialCells(xlLastCell).Row
    Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
        lRow = lRow - 1
    Loop
    fn_LastRow = lRow

End Function

'In this example we are finding the last column of specified Sheet
Function fn_LastColumn(ByVal Sht As Worksheet)

    Dim lastCol As Long
    Dim lCol As Long
    lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
    lCol = Sht.Cells.SpecialCells(xlLastCell).Column
    Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
        lCol = lCol - 1
    Loop
    fn_LastColumn = lCol

End Function
 

Carin

Board Regular
Joined
Feb 4, 2006
Messages
224
You're a genius! Thank you for explaining things in a simple manner. Half the time I'm getting great advice but I wouldn't know because I don't understand everything that the power users know (hence needing this site :) ) You were awesome. Thank you again.
 

KRice

Well-known Member
Joined
Dec 9, 2003
Messages
1,133
Office Version
  1. 2019
Platform
  1. Windows
You're quite welcome and thanks for the feedback...I'm happy to help.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,530
Messages
5,636,861
Members
416,946
Latest member
mniceguy81

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
Top