Thema Datum  Von Nutzer Rating
Antwort
Rot Blätter horizontal konsolidieren
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
15.07.2019 11:34:08 Gast79492
NotSolved

Ansicht des Beitrags:
Von:
tim
Datum:
12.07.2019 15:29:50
Views:
966
Rating: Antwort:
  Ja
Thema:
Blätter horizontal konsolidieren

Ich habe folgendes Makro zum konsolidieren von Blättern aus versch. Dateien.
 

Ich würde diese aber waagerecht konsoliedert benötigen (links nach rechts auffüllen) nicht oben nach unten. Leider bekomme ich es einfach nicht hin, die Range zu drehen... irgendwo habe ich einen Denkfehler. Hier der ursprgl Code:

[code]

Option Explicit
' ************************************************************************************************
' Autor/en: http://www.online-vba.de - Marc Wershoven
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von www.online-vba.de!
' Original-Quelltext: www.online-vba.de/vba_datensammeln5.php
' ************************************************************************************************


Sub MWTabellenAusMehrerenDateienEinlesen()
   Dim oTargetSheet As Object
   Dim oSourceBook As Object
   Dim sPfad As String
   Dim sDatei As String
   Dim lErgebnisZeile As Long
   Dim s As Long
   Dim z As Long
  
     Application.ScreenUpdating = False 'Das "Flackern" ausstellen
    
     'Schritt 1: Neues Arbeitsblatt für die Ergebnisse erstellen
     Set oTargetSheet = ActiveWorkbook.Sheets.Add
     lErgebnisZeile = 1 'Ergebnisse eintragen ab Zeile 1
    
     'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
     sPfad = "C:\TEST\Sammlung\"
     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("Tabelle1").UsedRange.Rows.Count
             'Keine Leerzeilen verarbeiten
             If Trim(CStr(oSourceBook.Sheets("Tabelle1").Cells(z, 1).Value)) <> "" Then
                 For s = 1 To oSourceBook.Sheets("Tabelle1").UsedRange.Columns.Count
                     'Spalte 1 - Dateinamen
                     oTargetSheet.Cells(lErgebnisZeile, 1).Value = sDatei
                     'Spalte 2 bis n - Tabelleninhalte des Arbeitsblattes "Tabelle1"
                     oTargetSheet.Cells(lErgebnisZeile, s + 1).Value = _
                         oSourceBook.Sheets("Tabelle1").Cells(z, s).Value
                 Next s
                 lErgebnisZeile = lErgebnisZeile + 1
             End If
         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[/code]


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 Blätter horizontal konsolidieren
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
15.07.2019 11:34:08 Gast79492
NotSolved