Neues Makro zur Excel Tabelle hinzufügen, folgendes Makro einfügen (ggf. Dateipfad anpassen), Makro starten und warten bis es abgeschlossen ist:
Option Explicit
Sub ImportCSVFiles()
Dim strFolderName As String, _
strFileName As String
Dim wbkThisWbk As Workbook, _
wbkMyCSVFile As Workbook
Dim shtMyTab As Worksheet
Dim lngMyRow As Long, _
lngMyCol As Long, _
lngPasteRow As Long
Dim strMyCol As String
Dim blnIncludeHeader As Boolean
Dim xlnCalcMethod As XlCalculation
Set wbkThisWbk = ThisWorkbook
Set shtMyTab = ActiveSheet 'Imports the data into the activesheet. Change to suit i.e. to import into Sheet1 use this: Set shtMyTab = Sheets("Sheet1")
blnIncludeHeader = True
With Application
xlnCalcMethod = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.StatusBar = "Please wait while the files are imported..."
End With
'Initialise the following varibales to the first *.csv file in the designated folder
strFolderName = "C:\CSVImportTest\" 'Folder name containing the files. Change to suit, but don't forget the trailing backslash!!
strFileName = Dir(strFolderName & "*.csv") 'File types to import
Do Until strFileName = ""
Set wbkMyCSVFile = Workbooks.Open(strFolderName & strFileName)
'As a comma separated value file can only have one tab, it's OK to simply use the first sheet via index 1
With wbkMyCSVFile.Sheets(1)
If WorksheetFunction.CountA(.Cells) > 0 Then
lngMyRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lngMyCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
strMyCol = Left(Cells(1, lngMyCol).Address(True, False), Application.WorksheetFunction.Search("$", Cells(1, lngMyCol).Address(True, False)) - 1)
If blnIncludeHeader = True Then
.Range("A1:" & strMyCol & lngMyRow).Copy
Else
.Range("A2:" & strMyCol & lngMyRow).Copy
End If
Workbooks(wbkThisWbk.Name).Activate
Sheets(shtMyTab.Name).Select
If blnIncludeHeader = True Then
Range("A1").PasteSpecial xlPasteValues
Else
lngPasteRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Range("A" & lngPasteRow).PasteSpecial xlPasteValues
End If
End If
End With
Application.DisplayAlerts = False
wbkMyCSVFile.Close SaveChanges:=False
Application.DisplayAlerts = True
strFileName = Dir()
blnIncludeHeader = False
Loop
With Application
.Calculation = xlnCalcMethod
.StatusBar = ""
.ScreenUpdating = True
End With
MsgBox "Files have now been imported."
End Sub