Thema Datum  Von Nutzer Rating
Antwort
12.07.2019 15:29:50 tim
NotSolved
12.07.2019 15:57:27 Gast80988
NotSolved
12.07.2019 16:27:33 Gast8762
NotSolved
13.07.2019 02:31:27 Gast2985
NotSolved
13.07.2019 02:38:45 Gast2985
NotSolved
15.07.2019 11:28:16 Gast83350
NotSolved
Rot Blätter horizontal konsolidieren
15.07.2019 11:34:08 Gast79492
NotSolved

Ansicht des Beitrags:
Von:
Gast79492
Datum:
15.07.2019 11:34:08
Views:
439
Rating: Antwort:
  Ja
Thema:
Blätter horizontal konsolidieren

Sub MWTabellenAusMehrerenDateienEinlesen()
   Dim oTargetSheet As Object
   Dim oSourceBook As Object
   Dim sPfad As String
   Dim sDatei As String
   Dim lErgebnisSpalte As Long
   Dim s As Long
   Dim z As Long
   Dim s1 As Long
   Dim z1 As Long
   
 
     Application.ScreenUpdating = False 'Das "Flackern" ausstellen
    
     'Schritt 1: Neues Arbeitsblatt für die Ergebnisse erstellen
     Set oTargetSheet = ActiveWorkbook.Sheets.Add
     lErgebnisSpalte = 1 'Ergebnisse eintragen ab Zeile 1
    
     'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
     sPfad = "C:\Users\halletim\Desktop\Heinz Projekt\"
     sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
    
     Do While sDatei <> ""
    
         'Schritt 3: öffnen der Datei und Datenübertragung
         Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
        
         'Datenübertragung alle genutzten Zeilen und Spalten
         'For z = 1 To oSourceBook.Sheets(1).UsedRange.Rows.Count
         z1 = oSourceBook.Sheets(1).UsedRange.Rows.Count
         s1 = oSourceBook.Sheets(1).UsedRange.Columns.Count
             'Keine Leerzeilen verarbeiten
             'Spalte 1 - Dateinamen
             'oTargetSheet.Cells(1, lErgebnisSpalte).Value = sDatei
             'If Trim(CStr(oSourceBook.Sheets(1).Cells(z, 1).Value)) <> "" Then
                 'For s = 1 To oSourceBook.Sheets(1).UsedRange.Columns.Count
                
                 oSourceBook.Sheets(1).Range(Cells(1, 1), Cells(z1, s1)).Copy oTargetSheet.Range(Cells(1, lErgebnisSpalte), Cells(z1, s1))
                 
                     'Spalte 2 bis n - Tabelleninhalte des Arbeitsblattes 1
                     'lErgebnisSpalte = lErgebnisSpalte + 1
                     'oTargetSheet.Cells(1, lErgebnisSpalte).Value = _
                         'oSourceBook.Sheets(1).Cells(z, s).Value
                         
                         
                 'Next s
                 lErgebnisSpalte = lErgebnisSpalte + 1
            ' End If
             'lErgebnisSpalte = lErgebnisSpalte + 1
         'Next z
        
         'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
         oSourceBook.Close False 'nicht speichern
        
         'Nächste Datei
         sDatei = Dir()
     Loop
    
     Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
    
     'Variablen aufräumen
     Set oTargetSheet = Nothing
     Set oSourceBook = Nothing
End Sub
 


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
12.07.2019 15:29:50 tim
NotSolved
12.07.2019 15:57:27 Gast80988
NotSolved
12.07.2019 16:27:33 Gast8762
NotSolved
13.07.2019 02:31:27 Gast2985
NotSolved
13.07.2019 02:38:45 Gast2985
NotSolved
15.07.2019 11:28:16 Gast83350
NotSolved
Rot Blätter horizontal konsolidieren
15.07.2019 11:34:08 Gast79492
NotSolved