ich möchte ein Tabellenblatt ohne Verknüpfungen in eine andere Mappe kopieren wobei die Werte der Verknüpften Zellen erhalten bleiben sollen.
Über eine Lösung würde ich mich sehr freuen und bedanke mich schon in voraus.
Viele Grüße
Werner
Sub NurWerte()
Cells.Copy
Windows("Mappe2").Activate 'Namen anpassen
Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub
Gruß Matthias
Option Explicit
Sub BlattKopieOhneLink()
Dim vLinks, ii As Integer
' Blattnamen anpassen
Sheets("XXXXXXX").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
' in Zielmappe kopieren
.Sheets(1).Copy before:=Workbooks("Mitarbeiterablage.xls").Sheets(1)
.Close False ' temp. Mappe löschen
End With
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Private Sub CommandButton2_Click()
' MAinAblage Makro
' Makro am 29.08.2008 von Werner Zapf aufgezeichnet
ChDir _
"C:\Dokumente und Einstellungen\Werner.ZAPF-PC1.003\Eigene Dateien\Kalkulation _
Kostenrechnung 23.08.2008"
Workbooks.Open Filename:= _
"C:\Dokumente und Einstellungen\Werner.ZAPF-PC1.003\Eigene Dateien\Kalkulation _
Kostenrechnung 23.08.2008\Mitarbeiterablage.xls"
Windows("Kalkulation-Kostenrechnung Römerbad 25.07.2008.xls").Activate
Sheets("Tabelle1").Select
Sheets("Tabelle1").Copy After:=Workbooks("Mitarbeiterablage.xls").Sheets(1)
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
End Sub
Das Funktioniert von Prinzip sehr Gut. In den Kopierten Tabellenblatt in Zelle B5 steht nun = '[Kalkulation-Kostenrechnung Römerbad 25.07.2008.xls]Startcenter'!D12.
Wenn nun in der Orginal Tabelle1 der Wert durch den Bezug =........ geändert wird, wird auch in der Kopie der Wert in diesen Fall ein Name geändert!!
Wie kann ich das Makro so ergänzen,dass in der Kopie in Zelle B5 nur der Name und nicht der Bezug erhalten bleibt.
Viele Grüße
Werner
Option Explicit
Private Sub CommandButton2_Click()
Dim vLinks, ii As Integer
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
' Mitarbeiterablage speichern + schließen
Workbooks("Mitarbeiterablage.xls").Close True
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
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