ich habe 2 Arbeitsmappen.
Ich verschiebe von der der aktuellen (also von der ich das Makro ausführe) Arbeitsmappe
in eine andere - dich ich zuvor ausgewählt habe.
Dabei möchte ich aber nicht das aus den ausgewählten Sheets die Namen mit in die andere Arbeitsmappe überführt werden.
Irgendwie habe ich hier einen Fehler...
vg
Option Explicit
Sub Archivieren3()
Call ListSheetsBetweenStartEnd ' / Projektübersicht erst aktualisieren
Dim varDatei As Variant, avntLinks As Variant, vntLink As Variant
Dim n As Name
Dim iSheetZaehler, iAnzahlSheets, o As Integer
Dim iAuswahlSheets(510) As Integer
Dim wsALT As Worksheet
Dim wbALT As Workbook
Dim wbNEU As Workbook
Dim ltzZeileArchiv As Long
Dim sArchivSpalte As String
Dim sBlattnummerSpalte As String
Dim i As Long
'Spalte in der Übersichtstabelle in der ausgewählt wird welche
'Tabelle verschoben werden soll
sArchivSpalte = "U"
'In der Spalte werden die Blattnummer in der Übersichtstabelle angezeigt.
sBlattnummerSpalte = "C"
ltzZeileArchiv = Cells(Rows.Count, sArchivSpalte).End(xlUp).Row 'Letzte belegte Zeile in der _
Spalte ArchivSpalte "U" ermitteln
varDatei = Application.GetOpenFilename() 'Hole dir den Namen & Pfad der Archivdatei
If varDatei = False Then
MsgBox "Der Benutzer hat abgebrochen.", vbInformation
Exit Sub
Else
Application.ScreenUpdating = False
Set wsALT = ActiveSheet
Set wbALT = ActiveWorkbook
Set wbNEU = Workbooks.Open(varDatei)
For i = 1 To ltzZeileArchiv
If wsALT.Cells(i, sArchivSpalte) = "Ja" Then
wbALT.Worksheets(wsALT.Cells(i, sBlattnummerSpalte).Value + 2).Move _
Before:=wbNEU.Worksheets("Ende")
For Each n In ActiveSheet.Names ' Löschen der Namen in dem Workbook
n.Delete
Next
avntLinks = ThisWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
If IsArray(avntLinks) Then ' Löschen der kopierten Links in dem Workbook
For Each vntLink In avntLinks
ThisWorkbook.BreakLink Name:=vntLink, Type:=xlLinkTypeExcelLinks
Next
End If
Application.ScreenUpdating = True
End If
Next
End If
Call ListSheetsBetweenStartEnd
End Sub