Tabellenblätter extern kopieren

Hallo,
bin zum ersten Mal hier gelandet und hoffe, mein Problem gelöst zu bekommen.
Ich habe für meine Schule in Exzel ein Programm mit vielen Tabellenblättern geschrieben, in denen Zeugnisdaten eingetragen werden. Diese Daten werden dann mit in Word geschriebenen Vordrucken verknüpft und ausgedruckt, das klappt alles prima. Die einzelnen Tabellenblätter habe ich in einem Blatt zusammengefasst, das dann von Word angesprochen wird.
Jetzt mein Problem. Ich entwickle natürlich dieses Programm fort und mache das in meiner Masterdatei. Nun möchte ich die neuen Erkenntnisse in alle 18, identisch aufgebauten, Dateien hineinkopieren. Die Formeln, die sich auf Verknüpfungen innerhalb der einzelnen Tabellenblätter beziehen, sollen genauso in den 18 Dateien erscheinen. Leider wird beim Kopieren immer der Verweis auf meine Masterdatei als externer Bezug mit aufgenommen, ich will aber die Verknüpfung nur innerhalb jeder einzelnen Datei haben. Wie kann ich diese automatische Verknüpfung unterdrücken ? Oder aber, wie bekomme ich elegant die externe Verknüpfung wieder entfernt, ohne das in jeder Datei einzeln machen zu müssen ?
War das zu kompliziert beschrieben ?
Ich hoffe mal auf einen Lösungsvorschlag.
Viele Grüße
Klaus-Peter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Klaus-Peter,
folgendes Makro kopiert das aktive Tabellenblatt in alle, im Ordner "D:\Eigene Dateien\Zeugnisse" enthaltenen Excelmappen, als erste Tabelle. Die Formelbezüge sind auf diese Mappe ausgerichtet. Sollte sich die Masterdatei auch in diesem Ordner befinden, muss ich das Programm noch ergänzen. Wenn in den Mappen eine vorhandene Tabelle gelöscht werden muss, ist das kein Problem.


Option Explicit
Public Sub Klaus_Peter()
Dim myWorksheet As Worksheet, myRange As Range
Dim strAdressen() As String
Dim intIndex As Integer
Dim lngIndex As Long
Application.ScreenUpdating = False
Set myWorksheet = ActiveSheet
For Each myRange In myWorksheet.UsedRange
If myRange.HasFormula Then
lngIndex = lngIndex + 1
ReDim Preserve strAdressen(1 To lngIndex)
strAdressen(lngIndex) = myRange.Address
myRange.Value = "'=" & myRange.Formula
End If
Next
With Application.FileSearch
.LookIn = "D:\Eigene Dateien\Zeugnisse"
.FileType = msoFileTypeExcelWorkbooks
.Execute
For intIndex = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(intIndex)
myWorksheet.Copy Before:=ActiveWorkbook.Worksheets(1)
If lngIndex <> 0 Then
For lngIndex = 1 To UBound(strAdressen)
Range(strAdressen(lngIndex)).Formula = Mid(Range(strAdressen(lngIndex)).Value, 2)
Next
End If
ActiveWorkbook.Close SaveChanges:=True
Next
End With
If lngIndex <> 0 Then
For lngIndex = 1 To UBound(strAdressen)
myWorksheet.Range(strAdressen(lngIndex)).Formula = Mid(myWorksheet.Range(strAdressen(lngIndex)).Value, 2)
Next
End If
Application.ScreenUpdating = True
End Sub

Code eingefügt mit: Excel Code Jeanie
Gruß
Nepumuk
P.S. Ich hoffe inständig, dass du kein Deutschlehrer bist, der nun meine Erläuterung benotet.

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread