Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1100to1104
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

alle Blätter auf einem zusammenfassen

alle Blätter auf einem zusammenfassen
Bernd
Hallo,
ich habe eine Exceldatei mit einer unbekannten Anzahl von Blättern.
Z.B.
In Blatt "Lager A" habe ich Daten von A2:E4
In Blatt "Lager B" habe ich Daten von A2:K4
In Blatt "Lager C" habe ich Daten von A2:G4
also in jedem Blatt habe ich eine verschiedene Anzahl von Daten.
Nun möchte ich in einem Blatt, z.B. "Zusammenfassung" alle Daten ab A2 automatisch erfassen.
Zuerst alle aus "Lager A", direkt danach alle aus "Lager B" usw. bis sämtliche Blätter abgearbeitet sind.
Kann mir dabei bitte einer helfen.
Vielen Dank
Gruß Bernd

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: alle Blätter auf einem zusammenfassen
15.09.2009 20:36:39
Tino
Hallo,
hier mal ein erster Versuch.
Function FindLetzte(mySH As Worksheet) As Range
Dim LRow As Long, LCol As Long
Dim A As Long
 
 With mySH.UsedRange
   On Error Resume Next
        'Finde Zeile 
        LRow = .Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False, False).Row
        LRow = Application.Max(LRow, .Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row)
        If LRow = 0 Then LRow = 1
   
        'Finde Spalte 
        For A = .Columns(.Columns.Count).Column To .Columns(1).Column Step -1
              LCol = mySH.Columns(A).Find("*", , xlValues, xlWhole, xlByRows, xlPrevious).Row
              LCol = Application.Max(LCol, mySH.Columns(A).Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row)
              If LCol > 1 Then: LCol = A: Exit For
        Next A
        If LCol = 0 Then LCol = 1
 End With
 
 Set FindLetzte = mySH.Cells(LRow, LCol)
End Function

Sub Zusammen()
Dim meSh As Worksheet
Dim Bereich As Range, rNextFreie As Range
Dim iCalc As Integer
With Application
   iCalc = .Calculation
  .Calculation = xlCalculationManual
  .ScreenUpdating = False
  .EnableEvents = False
  
        'gehe davon aus in Zeile 1 ist Überschrift u. Tabelle ist nicht komplett gefüllt 
        Sheets("Zusammenfassung").UsedRange.Offset(1, 0).Value = ""

        For Each meSh In ThisWorkbook.Worksheets
         If meSh.Name Like "Lager*" Then
            
            Set Bereich = meSh.Range("A2", FindLetzte(meSh))
            
            If Intersect(Bereich, meSh.Rows(1)) Is Nothing Then
                With Sheets("Zusammenfassung")
                 Set rNextFreie = .Cells(FindLetzte(Sheets(.Name)).Row + 1, 1)
                End With
              Bereich.Copy rNextFreie
            End If
         
         End If
        Next meSh

  .Calculation = iCalc
  .ScreenUpdating = True
  .EnableEvents = True
End With
End Sub
Gruß Tino
Anzeige
Danke Tino. Läuft perfekt. o.w.t.
15.09.2009 21:16:00
Bernd
.
AW: alle Blätter auf einem zusammenfassen
16.09.2009 09:26:46
JogyB
Hi.
Schau Dir mal noch Daten - Konsolidieren an.
Das macht eigentlich genau das, was Du willst.
Gruss, Jogy

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige