AW: Inhalte Tabellenblätter zusammenfügen
24.10.2011 19:23:33
fcs
Hallo Annette,
dann muss in die For-Next-Schleife zusätzlich auf die Visible-Eigenschaft geprüft werden.
Das wird mit den beiden als "neu 2011-10-24" gekennzeichneten Zeilen gemacht.
Gruß
Franz
Private Sub CommandButton1_Click()
Dim wksTest As Worksheet
Dim ZeileLetzte As Long
Dim ZeileZusammen
Application.ScreenUpdating = False
With Me
ZeileLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
If ZeileLetzte > 9 Then
'Altdaten löschen
.Rows(10).ClearContents
If ZeileLetzte > 10 Then .Range(.Rows(11), .Rows(ZeileLetzte)).Delete
End If
ZeileZusammen = 9
End With
For Each wksTest In ThisWorkbook.Worksheets
If wksTest.Visible = xlSheetVisible Then 'Neu 2011-10-24
Select Case wksTest.Name
Case Me.Name
'do nothing
Case Else
With wksTest
ZeileLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
If ZeileLetzte > 9 Then
'Daten kopieren
.Range(.Rows(10), .Rows(ZeileLetzte)).Copy
Me.Cells(ZeileZusammen + 1, 1).PasteSpecial Paste:=xlPasteFormats
Me.Cells(ZeileZusammen + 1, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
End With
With Me
ZeileZusammen = .Cells(.Rows.Count, 1).End(xlUp).Row
'Zellbereich des Listenobjekts anpassen
.ListObjects(1).Resize .Range(.Cells(9, 1), .Cells(ZeileZusammen, 6))
End With
End Select
End If 'neu 2011-10-24
Next
With Me
.ListObjects(1).Sort.SortFields.Clear
.ListObjects(1).Sort.SortFields. _
Add Key:=Range(ListObjects(1).Name & "[[#All],[Klasse]]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With .ListObjects(1).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Application.ScreenUpdating = True
End Sub