Quick&Dirty - ungetestet
Sub DoiT()
'meine Tabellenblätter - Trennen = ","
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
'Tabelle "Übersicht"
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
'durch die Tabellen
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
Sub DoiT()
'meine Tabellenblätter - Trennen = ","
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
'Tabelle "Übersicht"
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
'durch die Tabellen
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
LG
|