Hallo zusammen,
habe folgenden Code der unter Excel 2003 läuft nur eben nicht mehr unter Excel 2010, es werden zwar die Tabellen kopiert aber die Makros werden nicht mit kopiert, ich hoffe doch das mir hier jemand helfen kann.
Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Sub Kopieren()
Dim Wiederholungen As Integer, Ende As Integer, Quelldatei As String, i As Integer, _
Neuer_Dateiname
ActiveSheet.Unprotect Password:="sfw"
Application.ScreenUpdating = False
'Speicherort
Dim lw_pfad As String
lw_pfad = ActiveSheet.Range("K1").Value
lw_pfad = InputBox(Range("f1") & " gebe hier bitte das Laufwerk und den Pfad an, wo die Kassierliste gespeichert werden soll ( z.B. C:\Test\06 ). " & Chr(13) & "Der Dateiname wird Automatisch erstellt.", "Datei speichern unter...", lw_pfad)
If lw_pfad = "" Then
MsgBox "Der Pfad wurde nicht angelegt, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
Exit Sub
Else
If Right(lw_pfad, 1) <> "\" Then lw_pfad = lw_pfad & "\"
ActiveSheet.Range("K1").Value = lw_pfad
'Ordner anlegen
If Dir(Range("K1"), vbDirectory) = "" Then
MakeSureDirectoryPathExists (Range("K1"))
MsgBox "Ordner wurde angelegt!"
End If
'Datei kopieren
Quelldatei = ActiveWorkbook.name
Workbooks.Add
For Wiederholungen = 1 To 3
Sheets(Wiederholungen).name = Workbooks(Quelldatei).Sheets(Wiederholungen).name
Workbooks(Quelldatei).Sheets(Wiederholungen).Cells.Copy
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteValues
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteFormats
Next
Diese zeile habe ich schon geändert:
ActiveWorkbook.SaveAs lw_pfad & ActiveSheet.Range("l2"), FileFormat:=xlOpenXMLWorkbookMacroEnabled
MsgBox Range("f1") & Chr(13) & "Die Datei wurde unter " & lw_pfad & ActiveSheet.Range("l2").Value & ".xlsm gespeichert.", , "OK"
End If
'ActiveWorkbook.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = False
End Sub
grüße
speedy
