diosinc
Dec 22, 2014, updated at 10:40:58 (UTC)
view16185
view13
0
Goto Top

Excel Makro um CSV Dateien auszuwerten und gesammelt anzuzeigen.

GermansolvedQuestionVB for ApplicationsDevelopment
Hallo zusammen,

ich habe hier im Forum ein VBA Script gefunden, welches ich gerne anpassen würde
leider sind meine VBA Kenntnisse nur minimal und hoffe das mir hier einer von euch
helfen kann.

Zunächst wurde ich gerne die CONST "csvpfad" mit der Variable aus der Ordnerauswahl
"strOrnder" füllen, dies ist leider nicht möglich? - Hat hier einer eine Idee?

Des Weiteren würde ich gerne nur Einträge aus den CSV Dateien anzeigen die in der zweiten
Spalte ein "failed" als Wert besitzen. Besteht die Möglichkeit das innerhalb des Makros
so durchzuführen?

Hier das Makro:

Sub ImportiereCSVDateien()

Dim strOrdner As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"  
        .Title = "Ordnerauswahl"  
        .ButtonName = "Auswahl..."  
        .InitialView = msoFileDialogViewList
        If .Show = -1 Then
            strOrdner = .SelectedItems(1)
            If Right(strOrdner, 1) <> "\" Then strOrdner = strOrdner & "\"  
          Else
            strOrdner = ""  
        End If
    End With

    Const csvpfad = "D:\csv\20141219_007"  
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, curCell As Range
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Set wbTarget = ThisWorkbook
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    'Lösche alle Worksheets bevor wir alle neu anlegen  
    While wbTarget.Worksheets.Count > 1
        wbTarget.Worksheets(1).Delete
    Wend
    wbTarget.Worksheets(1).Name = "Zusammenfassung"  
    wbTarget.Worksheets(1).Range("A:ZZ").Clear  
    For Each f In fso.GetFolder(csvpfad).Files
       If LCase(fso.GetExtensionName(f.Name)) = "csv" Then  
            Workbooks.OpenText Filename:=f.Path
            Set wbSource = ActiveWorkbook
            On Error Resume Next
            Set ws = wbTarget.Worksheets.Add(After:=wbTarget.Sheets(wbTarget.Sheets.Count))
            ws.Name = f.Name
            ws.Range("A:ZZ").Clear  
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True  
            wbSource.Worksheets(1).UsedRange.Copy Destination:=ws.Range("A1")  
            wbSource.Close False
        End If
    Next
    
    With wbTarget.Worksheets("Zusammenfassung")  
        Set curCell = .Range("B1")  
        For i = 2 To wbTarget.Worksheets.Count
            'Inhalt der CSV in das Zusammenfassungs-Sheet kopieren  
            wbTarget.Sheets(i).UsedRange.Copy Destination:=curCell
            'Name der Quelle in Spalte A schreiben  
            curCell.Offset(0, -1).Value = wbTarget.Sheets(i).Path
            'Zelle für nächsten Import setzen  
            Set curCell = curCell.Offset(wbTarget.Sheets(i).UsedRange.Rows.Count + 2, 0)
        Next
        'Spaltengröße im Zusammenfassungssheet automatisch anpassen  
        .UsedRange.EntireColumn.AutoFit
        .Select
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Importvorgang erfolgreich durchgeführt.", vbInformation  
    Set fso = Nothing
End Sub

Für eure Hilfe bedanke ich mich schon jetzt.
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 258309

Url: https://administrator.de/contentid/258309

Printed on: April 18, 2024 at 14:04 o'clock

13 Comments
Latest comment
Goto Top
Member: colinardo
colinardo Dec 23, 2014 updated at 14:00:35 (UTC)
Goto Top
Hallo diosinc,
habe dir hier mal ein Demo-Sheet gebaut, der Code vom ursprünglichen Beitrag ist nicht mehr ganz aktuell bzw. nicht mehr Up-to-Date wie man so schön sagt. Der neue ist wesentlich schneller und aufgeräumter:
ImportCSV_258309.xlsm

Sub ImportCSVFromFolder()
    Dim wsTemp As Worksheet, wsTarget As Worksheet, curCell As Range, CSVPFAD As String, fso As Object, f As Object, strCSVDelimiter As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"  
        .Title = "Ordnerauswahl"  
        .ButtonName = "Auswahl..."  
        .InitialView = msoFileDialogViewList
        If .Show = -1 Then
            CSVPFAD = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    'Legt das CSV-Trennzeichen für die Dateien fest  
    strCSVDelimiter = ";"  
    
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'Zielarbeitsblatt für die importierten Daten  
    Set wsTarget = Worksheets(1)
    wsTarget.Name = "Zusammenfassung"  
    'temporäres Arbeitsblatt für den Import der Daten erstellen  
    Set wsTemp = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    
    'Inhalt des Zusammenfassungsblattes löschen  
    wsTarget.UsedRange.Clear
    
    'Startausgabezelle festlegen  
    Set curCell = wsTarget.Range("A1")  
    For Each f In fso.GetFolder(CSVPFAD).Files
        If LCase(fso.GetExtensionName(f.Name)) = "csv" Then  
            'Temporäres Sheet löschen  
            wsTemp.UsedRange.Clear
            'CSV-Daten in Temporäres Sheet importieren  
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & f.Path, Destination:=wsTemp.Range("$A$1"))  
                .Name = "import"  
                .FieldNames = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePlatform = xlWindows
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileOtherDelimiter = strCSVDelimiter
                .Refresh BackgroundQuery:=False
                .Delete
            End With
            
            With wsTemp
                'Daten in Zielsheet kopieren  
                .UsedRange.Copy curCell
            End With
            'Ausgabezeile eins nach unten schieben  
            Set curCell = wsTarget.Cells(wsTarget.UsedRange.Rows.Count + 2, 1)
        End If
    Next
    'Temporäres Sheet löschen  
    wsTemp.Delete
    'Spalten anpassen  
    wsTarget.Columns.AutoFit
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Vorgang beendet!", vbInformation  
    Set fso = Nothing
End Sub
Als CSV-Trennzeichen ist im Moment das Semikolon(;) angegeben, das kannst du im Code in Zeile 17 ändern.

Grüße Uwe
Member: diosinc
diosinc Dec 23, 2014 at 13:30:50 (UTC)
Goto Top
Hallo Uwe,

super vielen Dank.

Leider erhalte ich nach der Ordnerauswahl (hier sind 6 CSV Dateien drin) den Fehler "Laufzeitfehler: 7 - Nicht genügend Speicher".
Das hatte mit der altern Version problemlos funktioniert. (Mein Rechner hat 8 GB RAM, daran sollte es auch nicht hängen)

Hast du vielleicht noch eine Idee?

Zusätzlich noch eine Frage: besteht die Möglichkeit den Inhalt der CSV Dateien noch zu Filtern? Also: z.B. wenn das CSV so aussehen würde:

xp0101001;OK;2014-12-19T10:33:16;
xp0101002;FEHLER;2014-12-19T10:33:16;
xp0101003;OK;2014-12-19T10:33:16;

Das in der Excel Ausgabe nur die Einträge mit "FEHLER" angezeigt werden würden?

Vielen Dank

Gruss
Member: colinardo
Solution colinardo Dec 23, 2014, updated at Dec 28, 2014 at 06:34:56 (UTC)
Goto Top
Zitat von @diosinc:
Leider erhalte ich nach der Ordnerauswahl (hier sind 6 CSV Dateien drin) den Fehler "Laufzeitfehler: 7 - Nicht genügend
Speicher".
kann ich hier leider nicht nachvollziehen. Der Code funktionierte bisher immer. Denke da hat Excel irgendein Problem mit einer deiner CSV-Dateien. Da müsstest du mir mal deine CSV-Files schicken (melde dich via PM dann schick ich dir meine Mailadresse)

Eventuell haben deine Files ein anderes Zeichenformat, das lässt sich in Zeile 44 festlegen.

Speichere dein Sheet auch noch mal erneut unter anderem Namen ab.

Zusätzlich noch eine Frage: besteht die Möglichkeit den Inhalt der CSV Dateien noch zu Filtern? Also: z.B. wenn das CSV
Das in der Excel Ausgabe nur die Einträge mit "FEHLER" angezeigt werden würden?
lässt sich machen, dazu änderst du folgenden Abschnitt (Zeile 53-56 des obigen Codes) so ab.
With wsTemp
     'Daten nach dem Wort "FEHLER" in der zweiten SPALTE der CSV filtern und in Zielsheet kopieren  
     .UsedRange.AutoFilter
     .UsedRange.AutoFilter Field:=2, Criteria1:="FEHLER"  
     .UsedRange.SpecialCells(xlCellTypeVisible).Copy curCell
End With
In diesem Fall setze ich Überschriften in jeder CSV-Datei voraus, andernfalls müssen noch zusätzlich Kleinigkeiten angepasst werden.

Mit diesem Code werden deine Daten jeweils einmal nach FAILED und OK in der zweiten Spalte gefiltert und dann in zwei unterschiedliche Sheets kopiert. (Deine CSV-Dateien haben keine Übeschriften, das wurde berücksichtigt)

Sub ImportCSVFromFolder()
    Dim wsTemp As Worksheet, wsOK As Worksheet, wsFailed As Worksheet, curCell As Range, CSVPFAD As String, fso As Object, f As Object, strCSVDelimiter As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"  
        .Title = "Ordnerauswahl"  
        .ButtonName = "Auswahl..."  
        .InitialView = msoFileDialogViewList
        If .Show = -1 Then
            CSVPFAD = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    'Legt das CSV-Trennzeichen für die Dateien fest  
    strCSVDelimiter = ";"  
    
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'Zielarbeitsblätter (OK/FAILED) vorbereiten  
    For Each ws In Worksheets
        If ws.Name = "OK" Then Set wsOK = ws  
        If ws.Name = "FAILED" Then Set wsFailed = ws  
    Next
    If wsOK Is Nothing Then
        Set wsOK = Worksheets.Add
        wsOK.Name = "OK"  
    End If
    If wsFailed Is Nothing Then
        Set wsFailed = Worksheets.Add
        wsFailed.Name = "FAILED"  
    End If
    
    'temporäres Arbeitsblatt für den Import der Daten erstellen  
    Set wsTemp = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    
    For Each f In fso.GetFolder(CSVPFAD).Files
        If LCase(fso.GetExtensionName(f.Name)) = "csv" Then  
            With wsTemp
                'AutoFilter deaktivieren  
                .AutoFilterMode = False
                'Temporäres Sheet löschen  
                .UsedRange.Clear
                'Dummyüberschrift für den Filter  
                .Range("A1").Value = "Dummyüberschrift"  
                'CSV-Daten in Temporäres Sheet importieren  
                With .QueryTables.Add(Connection:="TEXT;" & f.Path, Destination:=.Range("$A$2"))  
                    .Name = "import"  
                    .FieldNames = False
                    .AdjustColumnWidth = True
                    .RefreshPeriod = 0
                    .TextFilePlatform = 1252
                    .TextFileStartRow = 1
                    .TextFileParseType = xlDelimited
                    .TextFileTextQualifier = xlTextQualifierNone
                    .TextFileOtherDelimiter = strCSVDelimiter
                    .Refresh BackgroundQuery:=False
                    .Delete
                End With
                
                'Daten nach dem Wort "FAILED" in der zweiten SPALTE der CSV filtern und in Zielsheet "FAILED" kopieren  
                .UsedRange.AutoFilter
                .UsedRange.AutoFilter Field:=2, Criteria1:="FAILED"  
                .UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy wsFailed.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                
                'Daten nach dem Wort "OK" in der zweiten SPALTE der CSV filtern und in Zielsheet "OK" kopieren  
                .UsedRange.AutoFilter Field:=2, Criteria1:="OK"  
                .UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy wsOK.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            End With
        End If
    Next
    'Temporäres Sheet löschen  
    wsTemp.Delete
    'Spalten anpassen  
    wsOK.Columns.AutoFit
    wsFailed.Columns.AutoFit
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Vorgang beendet!", vbInformation  
    Set fso = Nothing
End Sub
Member: colinardo
colinardo Dec 27, 2014 at 11:05:00 (UTC)
Goto Top
Wenns das dann war, den Beitrag bitte noch auf gelöst setzen. Merci.
Member: Nik0laus
Nik0laus Oct 21, 2016 at 13:03:02 (UTC)
Goto Top
Das liest sich alles schon sehr nach dem, was ich suche, nur bekomme ich es nicht selber angepasst:
Ich möchte alle txt Dateien aus einem Ordner in eine Excel Tabelle nebeneinander einfügen. Dabei reicht mir eine Registerkarte aus.
In den txt Dateien liegen steht pro Zeile eine Zahl mit einem Komma als Dezimaltrennzeichen.
Falls das mit txt dateien nicht möglich ist, wäre es auch möglich diese txt Dateien als csv zu speichern
Member: kaiuwe28
kaiuwe28 Jan 24, 2018 at 15:13:20 (UTC)
Goto Top
Hallo Uwe,

besteht die Möglichkeit hier auch in der ersten Spalte den Dateinamen einzufügen, sodass jede Zeile aus der csv einen Verweis auf den Dateinamen hat?

In der csv, welche ich nutze, sind nur 5 bis 10 Zeilen drin. Meistens ist die 1. und 2. Zeile sowie die 4. und 5. Zeile gefüllt.

Danke dir schon einmal für den hier bereits zur Verfügung gestellten Code!

Gruß Jens
Member: colinardo
colinardo Jan 24, 2018 updated at 15:56:42 (UTC)
Goto Top
Servus Jens,
kein Problem, hier für den ersten geposteten Code, kleine Anpassung:
Wenn du's vergleichst siehst du die angepassten Stellen und kannst es auch für die anderen Codes verwenden.
Sub ImportCSVFromFolder()
    Dim wsTemp As Worksheet, wsTarget As Worksheet, curCell As Range, CSVPFAD As String, fso As Object, f As Object, strCSVDelimiter As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"  
        .Title = "Ordnerauswahl"  
        .ButtonName = "Auswahl..."  
        .InitialView = msoFileDialogViewList
        If .Show = -1 Then
            CSVPFAD = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    'Legt das CSV-Trennzeichen für die Dateien fest  
    strCSVDelimiter = ";"  
    
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'Zielarbeitsblatt für die importierten Daten  
    Set wsTarget = Worksheets(1)
    wsTarget.Name = "Zusammenfassung"  
    'temporäres Arbeitsblatt für den Import der Daten erstellen  
    Set wsTemp = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    
    'Inhalt des Zusammenfassungsblattes löschen  
    wsTarget.UsedRange.Clear
    
    'Startausgabezelle festlegen  
    Set curCell = wsTarget.Range("B1")  
    For Each f In fso.GetFolder(CSVPFAD).Files
        If LCase(fso.GetExtensionName(f.Name)) = "csv" Then  
            'Temporäres Sheet löschen  
            wsTemp.UsedRange.Clear
            'CSV-Daten in Temporäres Sheet importieren  
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & f.Path, Destination:=wsTemp.Range("$A$1"))  
                .Name = "import"  
                .FieldNames = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePlatform = xlWindows
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileOtherDelimiter = strCSVDelimiter
                .Refresh BackgroundQuery:=False
                .Delete
            End With
            
            With wsTemp
                'Daten in Zielsheet kopieren  
                .UsedRange.Copy curCell
                ' Dateinamen in erste Spalte vor die Zeilen schreiben  
                curCell.Offset(1, -1).Resize(.UsedRange.Rows.Count - 1, 1).Value = f.Name
            End With
            'Ausgabezeile eins nach unten schieben  
            Set curCell = wsTarget.Cells(wsTarget.UsedRange.Rows.Count + 2, 2)
        End If
    Next
    'Temporäres Sheet löschen  
    wsTemp.Delete
    'Spalten anpassen  
    wsTarget.Columns.AutoFit
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Vorgang beendet!", vbInformation  
    Set fso = Nothing
End Sub
Grüße Uwe
heart1
Member: kaiuwe28
kaiuwe28 Jan 26, 2018 at 09:20:40 (UTC)
Goto Top
Guten Morgen Uwe,

vielen Dank! Ich hatte 2 Zeilen bereits selbst angepasst, aber die 3. (neue Zeile) habe ich einfach nicht allein hinbekommen.
Klappt super und ich lerne immer wieder aus dem Forum.

Viele Grüße

Jens
Member: Frogel
Frogel Feb 02, 2023 at 21:38:44 (UTC)
Goto Top
Hallo zusammen,

ich habe ein ähnliches Problem und bin in VBA ach nicht so fit daher würde ich Hilfe benötigen.

Folgendes ich habe eine csv Datei de wie folgt aussieht
A000;2022.04.25;11:24:06;101;A1234;0001;32,000;000020000002
A000;2022.04.25;11:34:15;101;A5252;0001;56,000;000020000003
A000;2022.04.25;11:52:28;101;AA999;0001;120,000;000020000000
A000;2022.04.25;12:20:37;101;A1234;0001;32,000;000020000002
A000;2022.04.25;13:38:23;101;AA999;0001;47,000;000020000003

Hier möchte ich aber nur werte in die Excel automatisch beim Öffnen der Excel importieren, die im zweiten Abschnitt mit dem jeweils gewünschte Jahr haben (Jahreswert kommt dann aus einer bestimmten Zelle auf einem anderen tabellenblatt) Perfekt wäre es dann noch, wenn aus dem Abschnitt 5 auch nur Werte übernehmen könnte, die in einem extra Tabellenblatt stehen z. B. nur A5252 und AA999.

Ist das so möglich?

Schnmal danke für die Hilfe
Member: colinardo
colinardo Feb 03, 2023 updated at 08:25:16 (UTC)
Goto Top
Servus @Frogel,
kann man, VBA gerne als Auftrag (PN). Würde es aber gleich mit Powershell umsetzen geht wesentlich fixer
# Jahr
$year = 2022
# Werte der zu inkludierende Zeilen für Spalte 5
$include = 'A5252','AA999'  
# Ordner mit CSV-Dateien
$folder = 'D:\Daten'  
# Neue CSV mit den gefilterten Daten
$exportfile = 'D:\export.csv'  
# Daten filtern und exportieren
Get-Content "$folder\*.csv" | ConvertFrom-CSV -Delimiter ";" -Header (1..8) | ?{$_.2 -like "$year.*" -and $_.5 -in $include } | ConvertTo-CSV -Delimiter ";" -NoTypeInformation | select -skip 1 | out-file $exportfile
Grüße Uwe
Member: mrtamburineman
mrtamburineman Aug 23, 2023 at 11:07:51 (UTC)
Goto Top
Hallo zusammen,

leider habe ich keinerlei Erfahrungen im schreiben von Makros und benötige daher Eure Hilfe.

Im Grunde benötige ich nur eine Erweiterung des oberen Makros von Uwe. Dieses ist ja so aufgebaut, dass der komplette Text der CSV-Datei untereinander geschrieben wird.

Mein Problem ist, dass ich nur die Daten aus den Zellen A17:A27 benötige und diese sollten dann jeweils auf das Arbeitsblatt "Zusammenfassung" in eine Zeile geschrieben werden, wobei in der ersten Spalte immer der Titel stehen sollte (von vertikal auf horizontal transformieren).

Ich habe es bisher vergebens u.a. mit dem Befehl Range (A17:27) Copy curCell versucht, aber nichts funktionierte so wie wir es gerne hätten.

Ich wäre für eine Lösung sehr dankbar.

Gruß Rudi
Member: colinardo
colinardo Aug 23, 2023 updated at 13:31:13 (UTC)
Goto Top
Zitat von @mrtamburineman:
Mein Problem ist, dass ich nur die Daten aus den Zellen A17:A27 benötige und diese sollten dann jeweils auf das Arbeitsblatt "Zusammenfassung" in eine Zeile geschrieben werden, wobei in der ersten Spalte immer der Titel stehen sollte (von vertikal auf horizontal transformieren).

Servus Rudi,
willkommen auf Administrator.de!

Hier meine Interpretation deiner Schilderung:
Sub ImportCSVFromFolder()
    Dim wsTemp As Worksheet, wsTarget As Worksheet, curCell As Range, CSVPFAD As String, fso As Object, f As Object, strCSVDelimiter As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"  
        .Title = "Ordnerauswahl"  
        .ButtonName = "Auswahl..."  
        .InitialView = msoFileDialogViewList
        If .Show = -1 Then
            CSVPFAD = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    'Legt das CSV-Trennzeichen für die Dateien fest  
    strCSVDelimiter = ";"  
    
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'Zielarbeitsblatt für die importierten Daten  
    Set wsTarget = Worksheets(1)
    wsTarget.Name = "Zusammenfassung"  
    'temporäres Arbeitsblatt für den Import der Daten erstellen  
    Set wsTemp = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    
    'Inhalt des Zusammenfassungsblattes löschen  
    wsTarget.UsedRange.Clear
    
    'Startausgabezelle festlegen  
    Set curCell = wsTarget.Range("A1")  
    For Each f In fso.GetFolder(CSVPFAD).Files
        If LCase(fso.GetExtensionName(f.Name)) = "csv" Then  
            'Temporäres Sheet löschen  
            wsTemp.UsedRange.Clear
            'CSV-Daten in Temporäres Sheet importieren  
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & f.Path, Destination:=wsTemp.Range("$A$1"))  
                .Name = "import"  
                .FieldNames = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePlatform = xlWindows
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileOtherDelimiter = strCSVDelimiter
                .Refresh BackgroundQuery:=False
                .Delete
            End With
            
            With wsTemp
                ' Dateinamen in erste Spalte vor die Daten schreiben  
                curCell.Value = f.Name
                'Daten aus A17:A27 transponiert in Zielsheet kopieren  
                .Range("A17:A27").Copy  
                curCell.Offset(0, 1).PasteSpecial Transpose:=True
            End With
            'Ausgabezeile eins nach unten schieben  
            Set curCell = wsTarget.Cells(wsTarget.UsedRange.Rows.Count + 1, 1)
        End If
    Next
    'Temporäres Sheet löschen  
    wsTemp.Delete
    'Spalten anpassen  
    wsTarget.Columns.AutoFit
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Vorgang beendet!", vbInformation  
    Set fso = Nothing
End Sub
Grüße Uwe
Member: mrtamburineman
mrtamburineman Aug 24, 2023 at 06:10:47 (UTC)
Goto Top
Hallo Uwe,

das ist genau das was ich brauche. Funktioniert einwandfrei. Besten Dank!

Grüße Rudi
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
AlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 CommentsDaniEnd of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment