AW: Daten aus mehreren Blättern zusammenfassen
27.05.2013 13:13:55
fcs
Hallo Mr. Data,
ein entsprechendes Makro kann wie folgt aussehen.
Gruß
Franz
'vor dem Start des Makros das "neue" Blatt mit dem Suchwert in B3 aktivieren!
Sub Suche_nach_B3()
Dim varSuchen As Variant
Dim wksZiel As Worksheet, ZeileZiel As Long
Dim wksSuch As Worksheet
Dim rngGefunden As Range, rngSuchen As Range
Dim arrRanges As Variant, arrWertSpalte As Variant, intI As Integer
Set wksZiel = ActiveSheet
'zu durchsuchende Zellbereiche
arrRanges = Array("C11:C39", "I11:I39", "O11:O39", "U11:U39")
'zugehörige Spalten aus denen Werte ausgelesen werden sollen
arrWertSpalte = Array(4, 10, 16, 22) 'D, J, P, V
ZeileZiel = 5 'Zeile ab der Werte eingetragen werden sollen, wenn Spalte A leer.
With wksZiel
If .Cells(.Rows.Count, 1).End(xlUp).Row >= ZeileZiel Then
ZeileZiel = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End If
varSuchen = .Range("B3").Value
If varSuchen = "" Then
MsgBox "In Zelle B3 ist kein Suchwert eingetragen!"
Exit Sub
End If
End With
For intI = LBound(arrRanges) To UBound(arrRanges)
For Each wksSuch In ActiveWorkbook.Worksheets
Select Case wksSuch.Name
Case wksZiel.Name, "VWerte"
'diese Blätter nicht durchsuchen
Case Else
Set rngSuchen = wksSuch.Range(arrRanges(intI))
For Each rngGefunden In rngSuchen.Cells
If rngGefunden.Value = varSuchen Then
wksZiel.Cells(ZeileZiel, 1).Value = wksSuch.Range("E8")
wksZiel.Cells(ZeileZiel, 2).Value = wksSuch.Cells(rngGefunden.Row, 2)
wksZiel.Cells(ZeileZiel, 3).Value = wksSuch.Cells(rngGefunden.Row, _
arrWertSpalte(intI))
ZeileZiel = ZeileZiel + 1
End If
Next
End Select
Next wksSuch
Next intI
End Sub