Sheets durchlaufen und einzelne DS kopier

Hallo,
hatte vielleicht zufällig jemand schon mal ein ähnliches Problem und weiss eine Lösung ? :
Ich habe ein Mappe mit mehreren Tabellenblätter. Grob gesagt möchte ich mit einem Makro (fast) alle Tabellenblätter durchlaufen und bei allen Datensätze , die in der Spalte B den String "OUT" beinhalten, diese in eine Gesamtübersicht kopieren.
- Zuerst geht es um die Auswahl der Blätter. Es sollen nicht alle Tabellenblätter durchlaufen werden.
Ich habe mal eine Formel gesehen, mit der konnte man ein erstes Sheet (per Name) und ein letztes Sheet definieren. Alles was sich innerhalb der beiden Sheets (Trenner) an Tabellenblätter befand, wurde berücksichtigt.
So was in der Art habe ich mir vorgestellt. Ich habe zwischen meine Sheets zwei neue Sheets eingefügt, das erste heißt "FIRST" der zweite "LAST" . alles was sich nun zwischen "FIRST" und "LAST" befindet , soll berücksichtigt werden. So kann ich ganz locker einfach sheets zwischen die Beiden rein und raus schieben, ohne dass ich was an Code anfassen muss. Geht sowas per Makro.
- Wenn ja, soll das Makro einfach diese Tabellenblätter zwischen "FIRST" und "LAST" einzeln durchlaufen, jeweils die Spalte "B" durchlaufen und überall, wo in Spalte B "OUT" drin steht, soll die komplette Zeile in das Blatt "SUMMEN" kopiert werden.
So, dass ich am Schluss in dem Blatt "SUMMEN" alle Zeilen untereinander stehen haben bei denen in B das "OUT" stand. (aber wie gesagt, nur die sheets zwischen "FIRST" und "LAST" )
Die Datensätze sollten dann auf den Sheet "SUMMEN" erst ab Zeile 5 eingefügt werden.
Ist das per Makro möglich, wäre mir eine grosse Hilfe.
Danke mal
Jockel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Jockel,
ersetze den Code von CommanButton1 durch folgenden.

Private Sub CommandButton1_Click()
  Dim lngIndex As Long, lngNext As Long
  Dim rng As Range, rngF As Range
  Dim strFirst As String

  Sheets("Summe").Range("A5:A" & Rows.Count).EntireRow.Clear


  For lngIndex = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(lngIndex) Then
      With Sheets(ListBox1.List(lngIndex))
        Set rng = .Columns(2).Find(What:="OUT", LookAt:=xlWhole, LookIn:=xlValues, After:=.Cells(1, 2))
        If Not rng Is Nothing Then
          strFirst = rng.Address
          Do
            If rngF Is Nothing Then
              Set rngF = .Range(.Cells(rng.Row, 1), .Cells(rng.Row, .Columns.Count - 1))
            Else
              Set rngF = Union(rngF, .Range(.Cells(rng.Row, 1), .Cells(rng.Row, .Columns.Count - 1)))
            End If
            Set rng = .Columns(2).FindNext(rng)
          Loop While Not rng Is Nothing And rng.Address <> strFirst
        End If
      End With
      If Not rngF Is Nothing Then
        With Sheets("Summe")
          lngNext = Application.Max(5, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
          rngF.Copy .Cells(lngNext, 2)
          .Range(.Cells(lngNext, 1), .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row, 1)) = rngF.Parent.Name
        End With
      End If
      Set rng = Nothing
      Set rngF = Nothing
    End If
  Next

  Unload Me
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Sheets durchlaufen und einzelne DS kopier

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Sheets durchlaufen und einzelne DS kopier

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread