Gruppe
Allgemein
Problem
Wie kann ich aus einer Serie von Tabellenblättern alle Teilergebnisse in ein gesondertes Blatt kopieren?
StandardModule: basMain
Sub TeilErgebnisseKopieren()
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim rng As Range
Dim iCounter As Integer, iCounterC As Integer
Dim iRowS As Integer, iRowT As Integer
Set wksTarget = Worksheets(Worksheets.Count)
wksTarget.Cells.ClearContents
For iCounter = 1 To Worksheets.Count - 1
Set wksSource = Worksheets(iCounter)
For iCounterC = 1 To wksSource.Range("A5"). _
CurrentRegion.Columns.Count
iRowS = 7
Do Until IsEmpty(wksSource.Cells(iRowS, iCounterC))
Set rng = wksSource.Cells(iRowS, iCounterC)
If InStr(rng.FormulaLocal, "TEILERGEBNIS") Then
iRowT = iRowT + 1
wksTarget.Cells(iRowT, iCounterC) = rng
End If
iRowS = iRowS + 1
Loop
iRowT = 0
Next iCounterC
Next iCounter
End Sub