AW: Daten aus mehreren Tabellen
27.12.2004 16:08:19
Josef
Hallo Marius!
Sollte funzen:
Option Explicit
Private Function SheetExist(ByVal sheetName As String, Optional WbName As String) As Boolean
Dim wks As Worksheet
On Error GoTo ERRORHANDLER
If WbName = "" Then WbName = ThisWorkbook.Name
For Each wks In Workbooks(WbName).Worksheets
If wks.Name = sheetName Then SheetExist = True: Exit Function
Next
ERRORHANDLER:
SheetExist = False
End Function
Sub zusammenfassung()
Dim wks As Worksheet
Dim wksZ As Worksheet
Dim lRow As Long
Dim n As Integer
On Error GoTo ERRORHANDLER
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
If SheetExist("Zusammenfassung") Then
Set wksZ = Sheets("Zusammenfassung")
wksZ.Range("C11:H450").ClearContents
Else
Set wksZ = Worksheets.Add(after:=Sheets(Sheets.Count))
wksZ.Name = "Zusammenfassung"
End If
lRow = 11
For Each wks In ThisWorkbook.Worksheets
With wks
If .Name <> wksZ.Name Then
For n = 11 To 51
If .Cells(n, 3) <> "" Then
.Range(.Cells(n, 3), .Cells(n, 8)).Copy
wksZ.Cells(lRow, 3).PasteSpecial xlPasteValues
lRow = lRow + 1
End If
Next
End If
End With
Next
ERRORHANDLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.CutCopyMode = False
End With
End Sub
Gruß Sepp