Bemerkungen zur abgeänderten Datei
08.04.2013 11:22:30
Erich
Hi Fred, hi Matze,
zu dem Code
Private Sub Worksheet_Activate()
Dim wks As Worksheet
Dim letzteZ As Long, x As Long
Application.ScreenUpdating = False
With Worksheets("Gesamt")
.Range(Rows(2), Rows(Rows.Count)).Delete
For Each wks In Worksheets
If wks.Name "Gesamt" Then
x = Sheets(wks.Name).Cells(Rows.Count, 1).End(xlUp).Row + 1
letzteZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If x > 2 Then
wks.Cells(2, 1).Resize(wks.UsedRange.Rows.Count - 1, 9).Copy .Cells(letzteZ, 1)
End If
End If
Next
.Range("A:I").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'die muss doch hier hin
End With
Application.ScreenUpdating = True
End Sub
habe ich ein paar kritische Anmerkungen.
1.
Muss es "Worksheet_Activate" sein, also bei jedem Wechsel zum Blatt "Gesamt" laufen?
Oder soll der Code nur laufen beim Öffnen der Mappe (vgl. "AutoOpen" in Freds Code zu Beginn).
(Dann würde ich "Workbook_Open" anstelle des antiquierten "AutoOpen" verwenden.)
Wenn man das "Private" weglässt, kann man die Prozedur auch leicht zu Fuß starten,
etwa nach einer Änderung der Daten.
2.
"With Worksheets("Gesamt")" ist überflüssig. Denn alle nicht weiter bestimmten Bezüge wie Columns() usw.
beziehen sich auf das Blatt, in dem der Code steht. Der Blattname kommt im Code besser nicht vor.
Man kann dann den Blattnamen ändern, ohne den Code anpassen zu müssen.
3.
If wks.Name "Gesamt" Then
Auch hier braucht der Name "Gesamt" nicht zu stehen. ".Name" (in der With-Klammer) oder "Me.Name"
(wenn ohne With-Klammer) reicht aus.
4.
Ist Sheets(wks.Name) etwas anderes als wks? Statt
x = Sheets(wks.Name).Cells(...) reichte
x = wks.Cells(...)
5.
Mit
x = Sheets(wks.Name).Cells(Rows.Count, 1).End(xlUp).Row + 1
ist die Anzahl Quellzeilen bekannt. Warum dann
Resize(wks.UsedRange.Rows.Count - 1, ...) ?
x hängt nur von Spalte A ab, wks.UsedRange.Rows.Count - 1 kann größer sein
6.
SpecialCells(xlCellTypeBlanks) ist Nothing, wenn keine leere Zelle gefunden wird, dann tritt Fehler 1004 auf.
7.
SpecialCells(xlCellTypeBlanks).EntireRow.Delete löscht eine Zeile auch dann,
wenn sie nicht komplett leer ist. Es reicht eine leere Zelle in der Zeile.
Nach 1. die Frage: Wann soll der Code laufen?
Und nach 7.: Muss vor dem Löschen einer Zeile geprüft werden, dass die Zellen in allen Spalten A:I leer sind,
oder soll schon dann gelöscht werden, wenn die Zelle in Spalte A leer ist?
Um nicht nur zu meckern, hier zwei Code-Varianten. Die zweite gehört in das Modul zu " _
DieseArbeitsmappe".
Option Explicit
Private Sub Worksheet_Activate()
Dim wks As Worksheet, lngZ As Long, lngQ As Long, rngDel As Range
Application.ScreenUpdating = False
Range(Rows(2), Rows(Rows.Count)).Delete
lngZ = 2
For Each wks In Worksheets
If wks.Name Me.Name Then
lngQ = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row - 1
If lngQ > 0 Then
wks.Cells(2, 1).Resize(lngQ, 9).Copy Cells(lngZ, 1)
lngZ = lngZ + lngQ
End If
End If
Next wks
For lngQ = 2 To lngZ - 1
If IsEmpty(Cells(lngQ, 1)) Then
If rngDel Is Nothing Then
Set rngDel = Cells(lngQ, 1)
Else
Set rngDel = Union(rngDel, Cells(lngQ, 1))
End If
End If
Next lngQ
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub Workbook_Open()
Dim wks As Worksheet, lngZ As Long, lngQ As Long, rngDel As Range
Application.ScreenUpdating = False
With Worksheets("Gesamt")
.Range(.Rows(2), .Rows(.Rows.Count)).Delete
lngZ = 2
For Each wks In Worksheets
If wks.Name .Name Then
lngQ = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row - 1
If lngQ > 0 Then
wks.Cells(2, 1).Resize(lngQ, 9).Copy .Cells(lngZ, 1)
lngZ = lngZ + lngQ
End If
End If
Next wks
For lngQ = 2 To lngZ - 1
If IsEmpty(.Cells(lngQ, 1)) Then
If rngDel Is Nothing Then
Set rngDel = .Cells(lngQ, 1)
Else
Set rngDel = Union(rngDel, .Cells(lngQ, 1))
End If
End If
Next lngQ
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich