Category Archives: Windows

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

Quelle: http://www.mrexcel.com/forum/excel-questions/674828-combine-100-excel-csv-files-one-sheet-each-into-one-sheet.html#post3342776