Sub
DoiT()
Const
C_TbNames
As
String
=
"Tabelle1,Tabelle2,Tabelle3,Tabelle4,Tabelle5"
Dim
Sh
As
Excel.Worksheet
Dim
Wsh
As
Excel.Worksheet
Dim
Arr()
As
String
, V
As
Variant
Dim
Ziel
As
Range, Quelle
As
Range
On
Error
Resume
Next
Set
Sh = Sheets(
"Übersicht"
)
If
Err.Number <> 0
Then
Sheets.Add Before:=Sheets(1)
ActiveSheet.Name =
"Übersicht"
Set
Sh = ActiveSheet
End
If
On
Error
GoTo
0
Sh.Cells.Clear
Sh.Cells(1) =
Date
Arr = Split(C_TbNames,
","
)
For
Each
V
In
Arr
With
Sh
Set
Ziel = .Cells(.Rows.Count, 1).
End
(xlUp)(3)
End
With
Set
Wsh = Sheets(V)
With
Wsh
Set
Quelle = .Columns(1).Find(Sh.Cells(1), , xlValues)
If
Not
Quelle
Is
Nothing
Then
_
Quelle.Resize(7).EntireRow.Copy Ziel
End
With
Next
V
End
Sub