speichern, speichern copy u. Module/Makros löschen

Hallo Ihr lieben Helfer dort draußen in der Dunkelheit,
ich habe mal wieder ein Problem, und finde weder eine Lösung, noch einen vernünftigen Lösungsansatz obwohl ich seit fast einer Std. das Archiv durchstöbere.
Folgendes Problem:
Ich habe eine Datei die ich automatisch mit dem Zellenname A1 abspeichere // das krieg ich noch hin
Jetzt kommen meine Probleme
Ich möchte jetzt in folgender Reihenfolge etwas per VBA machen immer aus der Originaldatei heraus
1) Die gleiche Datei jetzt unter dem Zellname A1 & "_Viewer" speichern // das kriege ich noch hin
2) NUR auf die Viewer Datei im Blatt 2 einen Schreibschutz mit Passwort setzen // da hapert es etwas
3) Aus der Originaldatei heraus in der Viewerdatei alle Module, Formulare, Klassenmodule und sämtliche Code aus DieseArbeitsmappe löschen // VBA Code zum löschen finde ich ja aber die Ausführung in einer anderen Datei klappt nicht
4) die Viewerdatei speichern ohne erneutes Nachfragen
5) Die Originaldatei geöffnet lassen
Puuuh, hoffe das kommt bei Euch verständlich rüber.
Danke im Voraus für Eure Hilfe
Gruß
Claudia

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Claudia() Workbooks.Add ThisWorkbook.Worksheets("Bearbeiten").Cells.Copy Range("a1") ActiveSheet.Name = "Bearbeiten" ' Speichetn Datei da gibt es Beispiele im Forum, ich habe Versio 2007 i Einsatz dort ist es _ anders ActiveWorkbook.Close End Sub

Hallo,
speichert eine Kopie im aktuellen Speicherpfad, Makros werden gelöscht.
Dem Zugriff auf VBA- Projekte, muss vertraut werden.

Sub TestMakro()
Dim Tabellen()
Dim a As Integer
Dim NeueDatei As Workbook
Dim VBAc As Object
Dim sPfad As String

sPfad = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
'Neuer Name für die Kopie 
sPfad = sPfad & "Copy " & Format(Now, "dd_mm_yy hh_mm_ss ") & ThisWorkbook.Name

With ThisWorkbook
    For a = 1 To .Sheets.Count
     Redim Preserve Tabellen(a - 1)
     Tabellen(a - 1) = .Sheets(a).Name
    Next a
    
    .Sheets(Tabellen).Copy
End With
Set NeueDatei = ActiveWorkbook

With NeueDatei
    For Each VBAc In NeueDatei.VBProject.VBComponents
        If VBAc.Type = 100 Then
             With VBAc.CodeModule
                 .DeleteLines 1, .CountOfLines
             End With
        End If
    Next VBAc
End With

NeueDatei.SaveAs sPfad
NeueDatei.Close False

End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

speichern, speichern copy u. Module/Makros löschen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread