Office: (Office 2010) Mehrere Zeilen rauskopieren und untereinander schreiben

Hey, ich habe mehrere CSV-Dateien, wo immer ab Zeile 13 fünf Spalten voll geschrieben sind, wieviele Zeilen untereinander pro Datei kommen, kann varrieren.

Nun nöchte ich gerne alls Zeilen ab Zeile 13 von jeder CSV-Datei untereinander in eine Excel-Datei schreiben.

Ist das irgendwie anders als von Hand möglich?

LG
Dicken

 

Hallo,

wenn Du Excel ab der Version 2013 hast, kannst Du PowerQuery dazu verwenden. In Excel 2013 musst Du dieses ggf. unter den COM-Add-Ins aktivieren, in Excel 2016 ist das bereits intergraler Bestandteil. Im Reiter PowerQuery (2013) bzw. Daten (2016) eine neue Abfrage zum Einlesen eines Orders erstellen. Dann werden alle CSV's in einem Rutsch eingelesen und mit dem PowerQuery Editor kannst Du noch mehr einstellen bzw. vornehmen. Eine detaillierte Erklärung wäre hier zu lang.

Gruß

 

Hey,

Das Makro öffnen einen Öffnen Dialog, in dem du den Ordner auswählen musst, in dem die .csv's sind. Dann werden alle .csv's ab Zeile 13 untereinander kopiert, die sich in diesem Ordner befinden.

Code:

Sub sammeln()
Dim fd, Pfad, Dateiname, lr
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show() = True Then
    Application.ScreenUpdating = False
    Pfad = fd.SelectedItems(1) & "\"
    Dateiname = Dir(Pfad & "*.csv")
    Do While Dateiname <> ""
     With Workbooks.Open(Pfad & Dateiname, , True, , , , , , , , , , , True)
      For sh = 1 To .Worksheets.Count
       .Worksheets(sh).Rows("1:12").Delete Shift:=xlUp
       .Worksheets(sh).UsedRange.Copy
       With ThisWorkbook.Worksheets(sh)
        .Range("A" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
       End With
      Next
      .Close False
     End With
     Dateiname = Dir()
    Loop
    Application.ScreenUpdating = True
End If
End Sub

Gruß