AW: Aus 4 Bereichen Zahlen auslesen und sortieren
11.07.2007 20:48:09
Peter
Hallo Salim,
so könnte es gehen:
Option Explicit
Public Sub Zusammenfuehren()
Dim aBlatt As Variant
Dim iIndex As Integer
Dim lLetzte As Long
Dim lZeile_Q As Long
Dim lZeile_Z As Long
Dim WkSh_Z As Worksheet
Application.ScreenUpdating = False
aBlatt = Array("Tabelle1", "Tabelle2", "Tabelle3", "Tabelle4")
Set WkSh_Z = Worksheets("Tabelle5")
For iIndex = 0 To 3
With Worksheets(aBlatt(iIndex))
lLetzte = IIf(.Range("A65536") "", 65536, .Range("A65536").End(xlUp).Row)
For lZeile_Q = 1 To lLetzte
If .Range("A" & lZeile_Q).Value "" Then
If Application.WorksheetFunction.CountIf _
(WkSh_Z.Columns(1), .Range("A" & lZeile_Q).Value) = 0 Then
lZeile_Z = lZeile_Z + 1
WkSh_Z.Range("A" & lZeile_Z).Value = .Range("A" & lZeile_Q).Value
End If
End If
Next lZeile_Q
End With
Next iIndex
WkSh_Z.Activate
WkSh_Z.Columns("A:A").Sort _
Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Application.ScreenUpdating = False
End Sub
Gruß Peter