Tabellenblätter zusammenführen
08.02.2005 10:35:29
Martin
kann mir jemand sagen, wie ich das MAkro umschreiben muss, wenn ich nur bestimmte Tabellenblätter einschließen will. Habe nämlich noch anderen Blätter in der die Mappe eingefügt, die nicht mit berücksichtig werden dürfen.
Für einen Tipp wäre ich sehr dankbar.
Hier noch mal der Code:
Sub neut()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("Alle Adressen").Select
ActiveWindow.SelectedSheets.Delete
For i = 3 To Sheets.Count + 1
If i > Sheets.Count Then
Set NewSheet = Worksheets.Add
NewSheet.name = "Alle Adressen"
End If
If Sheets(i).name = "Alle Adressen" Then
MsgBox "Tabellenblatt Auswertung ist bereits vorhanden!"
Exit For
End If
Next i
Set ws1 = Worksheets("Alle Adressen")
anz1 = ws1.Cells(65356, 1).End(xlUp).Row
ws1.Range("a2:v" & anz1).ClearContents
For i = 1 To Sheets.Count
If Sheets(i).name <> "Alle Adressen" Then
anz1 = ws1.Cells(65356, 1).End(xlUp).Row
Set ws2 = Worksheets(Sheets(i).name)
anz2 = ws2.Cells(65356, 1).End(xlUp).Row
ws2.Range("a2:v" & anz2).Copy Destination:=ws1.Range("a" & anz1 + 1)
End If
Next i
Cells.Select
Selection.Columns.AutoFit
Sheets("ADohneADM").Select
Rows("1:1").Select
Selection.Copy
Sheets("Alle Adressen").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Alle Adressen").Select
Cells.Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.Select
ActiveWorkbook.Names.Add name:="AD", RefersToR1C1:= _
"='Alle Adressen'!R1:R65536"
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Select
Selection.AutoFilter
Range("A2").Select
Sheets("Start").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Anzeige