AW: Tabelle kopieren
31.08.2008 10:49:00
Erich
Hi Werner,
"das mit Deinen Vorschlag klappt leider nicht"? Ist das deine Meinung oder hast du es mal getestet?
Das, was du dann mit ", denn ..." schreibst, ist KEIN Grund dafür, dass das nicht klappen sollte.
(Ich weiß doch, was ich da programmiert UND GETESTET habe...)
Mit "klappt leider nicht" gibst du keinerlei Info darüber,
was am Ergebnis des Codes falsch oder unerwünscht wäre.
Oder gibt es eine Fehlermeldung, wenn du das Makro startest?
Das Anlegen einer temp(orären!) Mappe ein möglicher Schritt zur Lösung des Problems.
Hast du dir auch die Codezeilen hinter "Sheets("Tabelle1").Copy ' legt neue temp. Mappe an"
angesehen?
Wird da nicht die Mitarbeiterablage geöffnet und das Blatt hineinkopiert?
Wird nicht später die temporäre Mappe wieder geschlossen?
Du schreibst jetzt, dass in Zelle B5 der Bezug gelöscht werden soll. Bisher ging es immer darum,
ALLE Verknüpfungen auf diesem Blatt zu eliminieren. Um das leicht machen zu können, wird die
temp. Mappe verwendet. Hier kann das Makro alle Verknüpfungen löschen, ohne dass
andere Verknüpfungen in der Quell- oder der Zielmappe tangiert werden.
Hier habe ich auch noch das Umbebenennen des Blattes eingebaut:
Option Explicit
Private Sub CommandButton2_Click()
Dim vLinks, ii As Integer, strB As String
Sheets("Tabelle1").Copy ' legt neue temp. Mappe an
With ActiveWorkbook ' dort Links entfernen
vLinks = .LinkSources(Type:=xlLinkTypeExcelLinks)
If Not IsEmpty(vLinks) Then
For ii = 1 To UBound(vLinks)
.BreakLink Name:=vLinks(ii), Type:=xlExcelLinks
Next ii
End If
' Mitarbeiterablage öffnen
Workbooks.Open Filename:="C:\Dokumente und Einstellungen\Werner." & _
"ZAPF-PC1.003\Eigene Dateien\KalkulationKostenrechnung 23.08.2008\" & _
"Mitarbeiterablage.xls"
' in Zielmappe kopieren
.Sheets(1).Copy after:=Workbooks("Mitarbeiterablage.xls").Sheets(1)
.Close False ' temp. Mappe schließen
End With
' Blatt umbenennen
strB = ActiveSheet.Cells(5, 2)
If SheetTest(strB) Then
MsgBox "Das kopierte Blatt konnte in " & ActiveWorkbook.Name & _
" nicht umbenannt werden." & vbLf & vbLf & "Blatt '" & strB & _
"' war bereits vorhanden.", vbExclamation, "weise hin..."
Else
ActiveSheet.Name = strB
' Mitarbeiterablage speichern + schließen
Workbooks("Mitarbeiterablage.xls").Close True
End If
End Sub
Public Function SheetTest(strName As String) As Boolean 'von Dani am 29.08.08 14:43
On Error Resume Next 'www.herber.de/forum/archiv/1004to1008/t1005833.htm
SheetTest = Not Sheets(strName) Is Nothing
End Function
Rückmeldung (nach Test) wäre nett! - Grüße von Erich aus Kamp-Lintfort