Thema Datum  Von Nutzer Rating
Antwort
Rot Daten aus einem Ordner auslesen und neue Excel-Datei erstellen
26.03.2021 13:34:38 Mark
NotSolved
27.03.2021 12:39:11 ralf_b
NotSolved
29.03.2021 09:47:44 Mark
NotSolved
29.03.2021 10:43:47 ralf_b
NotSolved
29.03.2021 11:11:16 Mark
NotSolved
29.03.2021 11:27:22 ralf_b
NotSolved
29.03.2021 11:49:40 Mark
NotSolved
29.03.2021 12:01:59 ralf_b
NotSolved

Ansicht des Beitrags:
Von:
Mark
Datum:
26.03.2021 13:34:38
Views:
133
Rating: Antwort:
  Ja
Thema:
Daten aus einem Ordner auslesen und neue Excel-Datei erstellen

Hallo Leute :) 

mein Ziel ist es aus einem selbst ausgewählten Ordner (Verzeichnis) in jenem mehrere Excel-Dateien abgespeichert sind (mit unterschiedlichem Namen, aber die Tabellenblätter sind gleich benannt) pro Datei folgengenden Vorgang zu haben = und zwar soll im ersten Schritt eine neue Excel-Datei (Workbook) erstellt werden, in welches dann das Tabellenblatt "Gross", welches aus der ersten Datei aus dem ausgewählten Ordner stammt, kopiert und umbenannt in "Brutto" werden soll und unter einem bestimmten Pfad (s.Code) abgespeichert werden soll. Danach erfolgt das selbe mit der zweiten Datei aus dem ausgewählten Ordnerverzeichnis bis keine Datei im Ordner mehr vorzufinden ist. Absgepeichert soll jede Datei basierend auf dem Dateinamen im Ordnerverzeichnis (pro Datei unterschiedich) in einem neuen Ordner. 

Hier der Code: 

Sub Transfer()
   Dim oTargetBook As Object
   Dim oSourceBook As Object
   Dim sPfad As String
   Dim sDatei As String
   Dim oFileDialog As FileDialog
   Dim sFileName As String

     Application.ScreenUpdating = False 'Das "Flackern" ausstellen
     Application.DisplayAlerts = False 'Keine Fehlermeldungen anzeigen

     'Schritt 1: Schleife über alle Excel-Dateien in einem ausgewählten Verzeichnis
     Set oFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
     With oFileDialog
        .Title = "Verzeichnis auswählen..."
        .ButtonName = "Import"
        If .Show = -1 Then sPfad = .SelectedItems(1)
     End With
     
     sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien

      Do While sDatei <> ""

         'Schritt 2: Pro Datei im Verzeichnis eine neue Arbeitsmappe öffnen
         Set oTargetBook = Application.Workbooks.Add
         
         'Schritt 3: öffnen der Datei und Datenübertragung
         Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
         
         'Es wird immer ein bestimmtes Tabellenblatt namens "Gross" kopiert und in die neu erstellte Arbeitsmappe mit dem Namen "Brutto" eingefügt.
         oSourceBook.Worksheets(Gross).Copy After:=oTargetBook.Worksheets(oTargetBook.Sheets.Count)
         ActiveSheet.Name = "Brutto"
         oSourceBook.Close SaveChanges:=False
         
         On Error Resume Next

        'Schritt 4: Automatisches Speichern unter und Namensvergabe
        
        'Arbeitsmappenname hängt von dem Dateinamen im ausgewählten Verzeichnis ab und wird automatisch unter einem bestimmten Pfad abgespeichert
         sFileName = Left(sDatei, InStrRev(sDatei, ".") - 1)
         
         ActiveWorkbook.SaveAs Filename:= _
         "C:\Users\Markus\Desktop\Excel makro\Target" & sFileName & ".xls" _
         , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
         ReadOnlyRecommended:=False, CreateBackup:=False

         oTargetBook.Close

         'Wenn ein Fehler aufgetreten ist, wird dieser resettet
         If Err.Number <> 0 Then
            Err.Number = 0
            Err.Clear
         End If
         On Error GoTo 0

         'Nächste Datei
         sDatei = Dir()

     Loop

Beenden:
     Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
     Application.DisplayAlerts = True 'Fehlermeldungen wieder anzeigen
     
     If Trim(sPfad) = "" Then Exit Sub

     'Abschlussmeldung
     MsgBox "Fertig!"

     'Variablen aufräumen
     Set oTargetBook = Nothing
     Set oSourceBook = Nothing

End Sub

 

Vielen Dank im Voraus für eure Unterstützung :) 

lg


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Daten aus einem Ordner auslesen und neue Excel-Datei erstellen
26.03.2021 13:34:38 Mark
NotSolved
27.03.2021 12:39:11 ralf_b
NotSolved
29.03.2021 09:47:44 Mark
NotSolved
29.03.2021 10:43:47 ralf_b
NotSolved
29.03.2021 11:11:16 Mark
NotSolved
29.03.2021 11:27:22 ralf_b
NotSolved
29.03.2021 11:49:40 Mark
NotSolved
29.03.2021 12:01:59 ralf_b
NotSolved