Verknüpfungen entfernen

Sub Verknüpfungen_Entfernen() ' Makro1 Makro ' Verknüpfungen_aus_einem_kopierten_Tabellenblatt_entfernen ' Lösche die beiden Tabellenblätter ohne Fehlermeldung On Error Resume Next ScreenUpdating = False Application.DisplayAlerts = False If Worksheets.Count >= 2 Then Worksheets(2).Delete If Worksheets.Count >= 1 Then Worksheets(2).Delete On Error GoTo 0 Application.DisplayAlerts = True ' Aktiviere Makro.xls - wähle das Tabellenblatt "Fotoblatt" aus und aktiviere es Windows("Makro.xls").Activate Sheets(Array("Fotoblatt")).Select Sheets("Fotoblatt").Activate On Error Resume Next ' Versuche "115615" im ungesicherten Status zu aktivieren Workbooks("115615").Activate ' Versuche "115615" im gesicherten Status zu aktivieren Workbooks("115615.xls").Activate ' End Error checking. On Error GoTo 0 ' Überprüfe ob "115615" bereits geöffnet ist, wenn nicht, öffne es If Not ActiveWorkbook.Name = "115615.xls" And Not _ ActiveWorkbook.Name = "115615" Then Workbooks.Open Filename:="115615.xls" End If ' Kopiere das bereits ausgewählte Tabellenblatt "Fotoblatt" und kopiere es in die Datei "115615.xls" an 2.Stelle Sheets(Array("Fotoblatt")).Copy _ Before:=Workbooks("115615.xls").Sheets(2) ' Gehe in die Datei "115615.xls" und dessen Tabellenblatt "Fotoblatt" und suche nach Verknüpfungen "[Verschleiß*] und ersetzte diese Verknüpfungen in den Zellen mit -nichts- Windows("115615.xls").Activate Worksheets(1).Activate Sheets("Fotoblatt").Activate Cells.Replace What:="[Verschleiß*]", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Thomas,
ich habe mir deinen Code noch mal insgesamt angesehen - und verstehe manches nicht.
Am Anfang:

    If Worksheets.Count >= 2 Then Worksheets(2).Delete
'   If Worksheets.Count >= 1 Then Worksheets(2).Delete     'geht schief, wenn nur 1 Blatt ex.

Welche Blätter in welcher Mappe sollen hier gelöscht werden?
Wenn du in der gerade aktiven Mappe das 2. und 3. Blatt - falls existent - löschen willst, dann ohne On Error ... so:

    If Worksheets.Count >= 2 Then Worksheets(2).Delete
If Worksheets.Count >= 2 Then Worksheets(2).Delete

Wofür sind die folgenden drei Zeilen?

    Workbooks("Makro.xls").Activate
Sheets(Array("Fotoblatt", "noch eins")).Select
Sheets("Fotoblatt").Activate

Für das Kopieren sind sie unnötig.
(Du testest damit, ob in Makro.xls die genannten Blätter existieren - wenn nicht, gibts einen Fehler.)
Bei den Zeilen

On Error Resume Next
' Versuche "115615" im ungesicherten Status zu aktivieren
Workbooks("115615").Activate
' Versuche "115615" im gesicherten Status zu aktivieren
Workbooks("115615.xls").Activate
' End Error checking.
On Error GoTo 0
' Überprüfe ob "115615" bereits geöffnet ist, wenn nicht, öffne es
If Not ActiveWorkbook.Name = "115615.xls" And Not _
ActiveWorkbook.Name = "115615" Then
Workbooks.Open Filename:="115615.xls"
End If

ist mir das mit dem gesicherten/ungesicherten Status noch nicht untergekommen.
Was bedeutet das, und wie funktioniert Workbooks("115615").Activate ?
Das Kopieren funzt bei mir mit

    Workbooks("Makro.xls").Sheets(Array("Fotoblatt", "noch eins")).Copy _
after:=Workbooks("115615.xls").Sheets(1)

Dabei ist es egal, welche Mappe gerade aktiv ist.
Da aber jetzt die 115615.xls die aktive Mappe ist, reicht das aus:

    Workbooks("Makro.xls").Sheets(Array("Fotoblatt", "noch eins")).Copy after:=Sheets(1)

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Option Explicit Sub Verknüpfungen_Entfernen2() ' Verknüpfungen_aus_einem_kopierten_Tabellenblatt_entfernen ' Application.ScreenUpdating = False ' zum Testen auskommentiert lassen ' Lösche das 2. und 3. Tabellenblatt ohne Fehlermeldung - in welcher Mappe? Application.DisplayAlerts = False If Worksheets.Count >= 3 Then Worksheets(3).Delete If Worksheets.Count >= 2 Then Worksheets(2).Delete Application.DisplayAlerts = True On Error Resume Next Workbooks("115615.xls").Activate ' Versuche "115615.xls" zu aktivieren On Error GoTo 0 ' Überprüfe ob "115615.xls" bereits geöffnet ist, wenn nicht, öffne es If ActiveWorkbook.Name <> "115615.xls" Then Workbooks.Open Filename:="115615.xls" ' Kopiere bestimmte Tabellenblätter in die Datei "115615.xls" hinter 1. Tabellenblatt Workbooks("Makro.xls").Sheets(Array("Fotoblatt", "noch eins")).Copy after:=Sheets(1) ' Gehe in Tabellenblatt "Fotoblatt", suche nach Verknüpfungen "[Verschleiß*] ' und ersetzte diese Verknüpfungen in den Zellen mit -nichts- Sheets("Fotoblatt").Activate Cells.Replace What:="[Verschleiß*]", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False Application.ScreenUpdating = True End Sub

Hallo Thomas,
das Löschen der Verknüpfung(en) zu Verschleißblatt.xls kann nur funzen, wenn es in der aktiven Mappe (115615.xls)
auch ein Blatt "Verschleiß" gibt. Ist dem so?
Wenn ja, ginge das (besser als mit Replace) so

    ActiveWorkbook.ChangeLink "Verschleißblatt.xls", ActiveWorkbook.Name

(Du kannst das ja mal mit Makroaufzeichnung per Hand spielen:
Bearbeiten - Verknüpfungen - Quelle wechseln - und dann die aktive Mappe auswählen.)
zu "Set geoeffnet = ActiveWorkbook":
Ist geoeffnet als Workbook-Variable deklariert? Wäre gut.
Solange die betreffende Mappe nach dem Set nicht geschlossen wird, kannst du sie mit geoeffnet ansprechen.
(Den Namen der Variablen finde ich nicht so geschickt - alle offenen Mappen sind geöffnet...)
Schreib doch mal da, wo du die Mappe ansprechen willst, eine neue Zeile in den Code:
MsgBox geoeffnet.name
Dann sollte der Name der Mappe angezeigt werden.
Antwortest du mir noch auf die Frage, in welcher Mappe am Anfang des Makros das 2. und 3. Blatt gelöscht werden sollen?
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Sub Vorhandene_Tabellen_löschen() Set geoeffnet = ActiveWorkbook On Error Resume Next ScreenUpdating = False Application.DisplayAlerts = False geoeffnet.Activate i = 0 Do If Worksheets.Count >= 1 Then Worksheets(2).Delete If Charts.Count >= 1 Then Charts(1).Delete i = i + 1 Loop Until i > 2 On Error GoTo 0 Application.DisplayAlerts = True Call Vorlagetabellen_Kopieren End Sub

Sub Vorlagetabellen_Kopieren() Application.DisplayAlerts = False On Error Resume Next Workbooks.Open Filename:= _ "C:\Verschleißblatt.xls" On Error GoTo 0 ' MsgBox geoeffnet.Name Workbooks("Makro.xls").Sheets(Array("Fotoblatt 1", "Fotoblatt 2", "Auswertung Daten")).Copy After:=geoeffnet.Sheets(1) Application.DisplayAlerts = True Call Verknüpfungen_ändern End Sub

Option Explicit ' empfehle ich dir DRINGEND Dim geoeffnet As Workbook ' wird nicht mehr gebraucht, warum war das Variant? Sub Vorlagetabellen_Kopieren() Dim i As Integer, wbkZiel As Workbook Set wbkZiel = ActiveWorkbook ' Application.ScreenUpdating = False ' hier fehlte Application. ' Die Bildschirmaktualisierung würde ich erst nach dem Austesten abschalten... Application.DisplayAlerts = False For i = 0 To 1 If Worksheets.Count >= 2 Then Worksheets(2).Delete If Charts.Count >= 1 Then Charts(1).Delete Next i Application.DisplayAlerts = True Workbooks("Makro.xls").Sheets(Array("Fotoblatt 1", "Fotoblatt 2", _ "Auswertung Daten")).Copy After:=Sheets(1) Workbooks.Open Filename:="C:\Verschleißblatt.xls" wbkZiel.ChangeLink "Makro.xls", wbkZiel.Name Workbooks("Verschleißblatt.xls").Close False ' Application.ScreenUpdating = True ' solltest du auch wieder einschalten End Sub Sub Vorhandene_Tabellen_löschen_ALT() Dim i As Integer Set geoeffnet = ActiveWorkbook ' On Error Resume Next ' überflüssig und schädlich Application.ScreenUpdating = False ' hier fehlte Application. ' geoeffnet.Activate ' geoeffnet ist doch schon aktiv! Application.DisplayAlerts = False For i = 0 To 1 ' If Worksheets.Count >= 1 Then Worksheets(2).Delete ' Fehler bei nur 1 Worksheet If Worksheets.Count >= 2 Then Worksheets(2).Delete If Charts.Count >= 1 Then Charts(1).Delete Next i Application.DisplayAlerts = True ' On Error GoTo 0 ' überflüssig Call Vorlagetabellen_Kopieren Application.ScreenUpdating = True ' solltest du wieder einschalten End Sub Sub Vorlagetabellen_Kopieren_ALT() ' Application.DisplayAlerts = False ' überflüssig ' On Error Resume Next ' überflüssig und schädlich Workbooks.Open Filename:="C:\Verschleißblatt.xls" 'Ab hier ist Verschleißblatt.xls die aktive Mappe! ' On Error GoTo 0 ' überflüssig ' MsgBox geoeffnet.Name Workbooks("Makro.xls").Sheets(Array("Fotoblatt 1", "Fotoblatt 2", _ "Auswertung Daten")).Copy After:=geoeffnet.Sheets(1) ' Application.DisplayAlerts = True ' überflüssig Call Verknüpfungen_ändern_ALT End Sub Sub Verknüpfungen_ändern_ALT() ' Verschleißblatt.xls ist immer noch ActiveWorkbook ActiveWorkbook.ChangeLink "Makro.xls", ActiveWorkbook.Name Workbooks("Verschleißblatt.xls").Close End Sub

Beliebteste Forumthreads (12 Monate)

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread