Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
560to564
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
560to564
560to564
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Tabellenblätter zusammenführen

Tabellenblätter zusammenführen
08.02.2005 10:35:29
Martin
Hallo,
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Schau im Ursprungs-Thread nach
Jan
o.T.
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige