Zusammenfassung mehrere Tabellenblätten

Sub Zusammenfassung()
Dim z, s, r, lz As Long
Application.ScreenUpdating = False
Set sh1 = Sheets("Zusammenfassung")
For sh = 1 To Sheets.Count
If Not Sheets(sh).Name = "Zusammenfassung" Then
With Sheets(sh)
z = .UsedRange.Rows.Count
s = .UsedRange.Columns.Count
For r = 2 To z
Wert = .Cells(r, 1)
Set c = sh1.Columns(1).Find(What:=Wert, LookIn:=xlValues, LookAt:=xlWhole)
If c Is Nothing Then
lz = sh1.Cells(Rows.Count, 1).End(xlUp).Row + 1
Range(.Cells(r, 1), .Cells(r, s)).Copy sh1.Cells(lz, 1)
End If
Next r
End With
End If
Next sh
Application.ScreenUpdating = True
End 

Sub