Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Formeln und Namen löschen

Betrifft: Formeln und Namen löschen von: Mirko F.
Geschrieben am: 05.10.2020 10:08:09

Hallo,
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

Betrifft: AW: Formeln und Namen löschen
von: Mirko F.
Geschrieben am: 05.10.2020 10:09:46

Sorry ich korrigiere, keine Formeln sondern die Verknüpfungen löschen.

Betrifft: AW: Formeln und Namen löschen
von: ralf_b
Geschrieben am: 05.10.2020 10:52:55

hast du das mit den namen löschen mal ausprobiert?
zitat: For Each n In ActiveSheet.Names ' Löschen der Namen in dem Workbook

Workbook oder Sheet? du solltest in beiden Objekten auf Namen für das verschobene Blatt prüfen.
Sind Namen im alten Workbook vorhanden, die im verschobenen Blatt waren aber Workbook weit gültig sind, dann sind diese im alten WB noch vorhanden mit dem Link zur neuen Mappe.

Ein Löschen der Namen wäre vor dem Verschieben möglicherweise besser.

Betrifft: AW: Formeln und Namen löschen
von: Mirko F.
Geschrieben am: 05.10.2020 11:02:36

Ja die Frage ist, was ist in dem Moment "ActiveSheet".
Also im alten WB möchte ich die behalten.
und auch keinerlei Verlinkungen erzeugen.
Vg

Betrifft: AW: Formeln und Namen löschen
von: ralf_b
Geschrieben am: 05.10.2020 11:07:58

das kannst du doch selbst herausfinden wann welches sheet das activesheet ist.
Arbeitest du mit Haltepunkten und Schrittweisem Ausführen von Codezeilen mittels F8 Taste?

beim Move wird das neuewb zum avtivwb und auch das dorthin verschobene Blatt zum activesheet.
das sieht man auch ,da es dann vor dem altenwb auf dem desktop sichtbar ist.

Betrifft: AW: Formeln und Namen löschen
von: Mirko F.
Geschrieben am: 05.10.2020 11:10:22

Ja habe ich ja gemacht, aber warum auch immer kann ich bis zu diesem punkt es nicht schrittweise machen, der führt das direkt aus und fragt dann direkt ob ich die Namen kopieren möchte, dann klicke ich auf alle und das makro ist zu ende. Überwache auch die Variablen...

Sonst hätte ich schon mehrfach ausprobiert... :(

Betrifft: AW: Formeln und Namen löschen
von: ralf_b
Geschrieben am: 05.10.2020 11:30:51

Bei mir fragt da Niemand ob ich die Namen kopieren möchte. Kann sein das es an einer bestimmten Einstellung liegt. Aber das kann ich so nicht beurteilen.

Aber mir ist auch aufgefallen das ich mehrere vba-Projekte der gleichen Datei im Projektexplorer hatte. Wenn dann in der falschen Instanz ein Haltepunkt gesetzt wird, klappt das natürlich nicht.

Betrifft: AW: Formeln und Namen löschen
von: Mirko F.
Geschrieben am: 05.10.2020 13:07:05

Der code funktioniert ja wenn ich das Auskommentiert:

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

Das For Each kann ich nicht eher setzen, habe ich zu mindestens erfolglos probiert.

Betrifft: AW: Formeln und Namen löschen
von: ralf_b
Geschrieben am: 05.10.2020 13:18:39

zwischen ... '"Ja" then' und wbAlt.worksheets..... ist ne Menge Platz.
ein Activesheet gibt es immer.

Nur wenn es noch andere Namen gibt, die im Original nicht gelöscht werden dürfen, dann muß eine Einschränkung in die Abfrage.

So ohne deine Datei läßt sich da aber nichts wirklich genau nachvollziehen. du kannst sie mir per Mail schicken, dann liegt sie nicht offen für Jederman hier rum. Meine Mail findest du in meinem Profil.

Betrifft: AW: Formeln und Namen löschen
von: Mirko F.
Geschrieben am: 05.10.2020 13:28:02

Zunächst !!!Vielen Dank Ralf für deine Hilfe !! :)
Also die Namen die im zu verschiebenen Sheet sind, sind in der Arbeitsmappe für die gesamte Arbeitsmappe definiert.
Diese Namen soll er nicht mitkopieren, bzw. keine Verlinkung erstellen!!!
Die beiden Arbeitsmappen sollen nicht diese ewig lästigen Verknüpfungen haben.
Ich versuche mal die Dateien zu cleanen und dir zuzusenden.

vg

Betrifft: AW: Formeln und Namen löschen
von: Mirko F.
Geschrieben am: 05.10.2020 15:25:49

habs geschickt !

Betrifft: AW: Formeln und Namen löschen
von: ralf_b
Geschrieben am: 05.10.2020 16:56:31

habs bekommen, aber durch die Verschiebeaktion erstellt Excel offensichtlich einen Reihe interne Kopien der Namen, die sich nicht so einfach entfernen lassen. Ich glaube das liegt daran das die zu entfernenden Tabellen ein Teil der Namensmatrizzen sind und diese von Excel dann intern angepasst werden. Ein echt unerwartetes Problem.

Betrifft: AW: Formeln und Namen löschen
von: Mirko F.
Geschrieben am: 06.10.2020 09:10:19

Hi.Danke nochmal für deine Ergebnisse.
Zum Hintergrund- ich hatte den vba Code aus einer andere Mappe A kopiert.
In der Ursprungsmappe A habe ich das genau umgekehrt gewollt.

Hierbei sollte man die Datei B auswählen, aus der das erste Sheet aus B in die Arbeitsmappe A kopiert wurde und dann sollten die Links und Namen entfernt werden.
Da funktionierte das.

Sie den Text.
Sub Einlesen2()
    
    Dim varDatei As Variant, avntLinks As Variant, vntLink As Variant
    Dim Datei As Workbook
    Dim n As Name
    
    
    varDatei = Application.GetOpenFilename() 'Hole dir die Inputdateipfad
    
    If varDatei = False Then
        MsgBox "Der Benutzer hat abgebrochen.", vbInformation
        Exit Sub
    Else
        
        Application.ScreenUpdating = False
        
        Set Datei = Workbooks.Open(varDatei)
        
        Datei.Worksheets(1).Copy Before:=ThisWorkbook.Worksheets("Ende")
        
        Datei.Close False
        
 'STATUSLEISTE
Dim i As Long
Dim Zeit As Double
For i = 1 To 100
    Application.StatusBar = "Bearbeitet " & Format(i / 100, "0%") & " " & WorksheetFunction. _
Rept("IIIIIII", 20 * i / 100)
    Zeit = Timer + 0.1
'STATUSLEISTE
        
        
        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
        
    
    
    Do Until Timer > Zeit  'STATUSLEISTE
    Loop 'STATUSLEISTE
Next 'STATUSLEISTE
Application.StatusBar = False 'STATUSLEISTE

End If

Call DesignFitSteckbrief
    
End Sub

VG