Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
Screenshot zu MsgBox	MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Blatt kopieren + unter akt. Datum einfügen | Herbers Excel-Forum

• Blatt kopieren + unter akt. Datum einfügen von Anne vom 20.01.2010 11:52:58
• AW: Blatt kopieren + unter akt. Datum einfügen - von Tino am 20.01.2010 13:27:45
  • AW: Blatt kopieren + unter akt. Datum einfügen - von Tino am 20.01.2010 13:38:47
    • AW: Blatt kopieren + unter akt. Datum einfügen - von Anne am 20.01.2010 15:44:50
  • AW: Blatt kopieren + unter akt. Datum einfügen - von Anne am 20.01.2010 14:25:04

Betrifft: Blatt kopieren + unter akt. Datum einfügen von: Anne
Geschrieben am: 20.01.2010 11:52:58

Hallo an alle,

ich hab folgende Frage: Gibt es eine Möglichkeit, dass mein Makro das aktuelle Tabellenblatt kopiert und dieses in einer anderen Datei unter dem aktuellen Datum (als Tabellenblattname) gespeichert wird?Dies sollte dann immer hinter den vorher gehenden Tabellenblättern abgespeichert werden, so dass man am Ende mehrere Tabellenblätter in aufsteigender Reihenfolge mit z. B. "01.02.2010" dann "02.02.2010" usw. hat.
Ich würde mich über eine kleine Hilfestellung freuen!

Gruß Anne

Betrifft: AW: Blatt kopieren + unter akt. Datum einfügen von: Tino
Geschrieben am: 20.01.2010 13:27:45

Hallo,
kannst diesen Code mal testen.

Function CheckTabellen(strName$, oWB As Workbook) As Boolean
 On Error Resume Next
 CheckTabellen = oWB.Sheets(strName).Index > 0
End Function

Sub test()
Dim oWB As Workbook
Dim i As Integer, booCopy As Boolean, booNichtOffen As Boolean

On Error Resume Next
 'Datei offen?
 Set oWB = Workbooks("Ziel.xls")
On Error GoTo 0

If oWB Is Nothing Then
 'Datei nicht offen
 Set oWB = Workbooks.Open("D:\Ordner\Ziel.xls")
 booNichtOffen = True
End If

If CheckTabellen(CStr(Date), oWB) Then
 If booNichtOffen Then oWB.Close False
 MsgBox "Tabelle mit den Namen '" & CStr(Date) & "' ist schon vorhanden!"
End If
    
    If Not oWB.ReadOnly Then
        For i = 1 To oWB.Sheets.Count
           If IsDate(oWB.Sheets(i).Name) Then
             If Date > CDate(oWB.Sheets(i).Name) Then
                   ThisWorkbook.ActiveSheet.Copy After:=oWB.Sheets(i)
                   oWB.Sheets(i + 1).Name = Date
                   booCopy = True
                   Exit For
             End If
           End If
        Next i
        
        If Not booCopy Then
            ThisWorkbook.ActiveSheet.Copy After:=oWB.Sheets(oWB.Sheets.Count)
            oWB.Sheets(oWB.Sheets.Count).Name = Date
        End If
        
        If booNichtOffen Then
            oWB.Close True
        Else
            oWB.Save
        End If
        
        MsgBox "Tabelle erfolgreich übertragen", vbInformation
    Else
        If booNichtOffen Then oWB.Close False
        MsgBox "Ziel ist Schreibgeschützt!", vbCritical, "Fehler"
    End If

End Sub

Den Dateinamen und den Pfad musst Du im Code noch anpassen.
Ist die Datei bereits offen, wird diese verwendet.
Ist die Datei nicht offen wird diese geöffnet.
Zudem erfolgt noch eine Prüfung ob die Tabelle schon vorhanden ist.

Gruß Tino

Betrifft: AW: Blatt kopieren + unter akt. Datum einfügen von: Tino
Geschrieben am: 20.01.2010 13:38:47

Hallo,
da fehlt noch ein Exit Sub

ersetzte die Zeilen

If CheckTabellen(CStr(Date), oWB) Then
 If booNichtOffen Then oWB.Close False
 MsgBox "Tabelle mit den Namen '" & CStr(Date) & "' ist schon vorhanden!"
End If

durch diese

If CheckTabellen(CStr(Date), oWB) Then
 If booNichtOffen Then oWB.Close False
 MsgBox "Tabelle mit den Namen '" & CStr(Date) & "' ist schon vorhanden!"
 Exit Sub
End If

Gruß Tino

Betrifft: AW: Blatt kopieren + unter akt. Datum einfügen von: Anne
Geschrieben am: 20.01.2010 15:44:50

Hallo Tino,

ich habe die entsprechende Passage ersetzt.
Nochmals Dankeschön!

Gruß Tino

Betrifft: AW: Blatt kopieren + unter akt. Datum einfügen von: Anne
Geschrieben am: 20.01.2010 14:25:04

Hallo Tino,

Es funktioniert super!
Ich probiere es morgen nochmal, ob die Tabellenblätter in der richtigen Reihenfolge sind.
Viele Dank an dich!

Gruß Anne

Beiträge aus den Excel-Beispielen zum Thema "Blatt kopieren + unter akt. Datum einfügen"