Hallo
also ich hab jetzt ein Makro welches meine Datei auf einem anderen Pfad speichert.
die Makros sind auch alle weg, allerdings verstehe ich nicht, warum die Dateigröße unverändert bei 18 MB bleibt obwohl die Makros und alle nicht relevanten Tabellen gelöscht sind:( Wie ich gerade sehe ist die dateigröße sogar von 15 MB auf 18 MB angestiegen...
Ich habe gehofft dass sich dadurch die Dateigröße verringert.
Hat jmd eine Idee woran das liegt?
@fedjo: danke für die Hilfe.. aber leider funktioniert der Code bei mir nicht.Warum auch immer...
grüße
Sub Tabellen_in_neue_Dateien_kopieren()
'jede Tabelle dieser Datei als neue Datei speichern
'Dateiname ist jeweils der Tabellenname
Dim Pfad As String
Dim wks As Worksheet
Dim VBA_Code As Object
'Pfad anpassen
Pfad = "C:\Users\.........\Documents\"
'Pfad = ThisWorkbook.Path & "\"
'prüfen ob Pfad existiert
If Dir(Pfad) = "" Then
Msgbox "Pfad existiert nicht", , "Abbruch"
Exit Sub
End If
On Error GoTo Fehler
Application.ScreenUpdating = False
'eventuell schon vorhandene Datei ohne Rückfrage überschreiben
Application.DisplayAlerts = False
For Each wks In ThisWorkbook.Worksheets
If wks.Name = "Tabelle1" Then
ThisWorkbook.Worksheets(wks.Name).Copy
ActiveWorkbook.SaveAs (Pfad & wks.Name)
With ActiveWorkbook.VBProject
For Each VBA_Code In .VBComponents
Select Case VBA_Code.Type
Case 1, 2, 3: .VBComponents.Remove .VBComponents(VBA_Code.Name)
Case 100
With VBA_Code.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
End With
ActiveWorkbook.Close
End If
Next wks
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Msgbox "alle Tabellen gespeichert in" & vbNewLine & vbNewLine _
& Pfad, , ""
Exit Sub
Fehler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Msgbox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
, vbCritical, "Fehler"
End Sub
