Makros werden nicht übertragen
07.01.2009 13:21:00
Bernd
Hallo, liebe Excel-Freaks,
ich bitte Euch um Eure Hilfe. Nachstehendes Makro - das ich mit Hilfe dieses Forum erstellt habe - aktualisiert alle Blätter einer Abteilung mittels Sverweis und kopiert diese mit neuen Datei-Namen in ein Verzeichnis.
Leider kopiert das Makro dabei keine Makros, die in "Dieses Arbeitsblatt" und in Modulen enthalten ist. Code und Bsp.mappe nachstehend. Vielen Dank vorab für Eure Hilfe.
https://www.herber.de/bbs/user/58155.xls
Sub Automatisch_Aktualisieren_und_Speichern()
Dim Bereich As Range
Dim Zelle As Range
Dim MerkWert
i = MsgBox("Eckdatenblätter aktualisieren " & vbLf & vbLf & _
"und neu abspeichern? ", 4 + 32, "Daten auslesen")
If i = 7 Then Exit
Sub 'wenn "Nein", dann Ende
Set Bereich = Range("C23:c31")
With Application
MerkWert = Range("C13").Value
.ScreenUpdating = True
.EnableEvents = False
.DisplayAlerts = False
For Each Zelle In Bereich
Range ("C13")
'*********diese Tabellen werden kopiert, eventuell Name anpassen ***********
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3", "Modul1")).Copy
'UpdateLinkAbfrage auf "nein" setzen
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
'Datei speichern, ist diese vorhanden, wird sie überschrieben
With ActiveWorkbook
'Datei speichern, ist diese vorhanden wird sie überschrieben
.SaveAs ("C:\Kostenstellenblätter\" & Zelle.Text & ".xls")
'neue Datei schließen
.Close False
End With 'End with ActiveWorkbook
Next Zelle
Range("SAP_Knoten").Value = MerkWert
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Grüße
Bernd
Anzeige