Makro mit gestrigem Datum und Blattwechsel

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Makro mit gestrigem Datum und Blattwechsel von: wagner
Geschrieben am: 21.03.2005 21:49:51

Hallo Excel-Spezialisten,
da ich leider so gut wie keine VBA Kenntnisse habe wende ich mich an euch:

Ich habe viele gleiche Tabellen und muss täglich in allen Datein das Selbe erledigen:
In Blatt 2 das gestrige Datum in die nächste leere Zelle der Spalte B eingeben
(Nur Montags das Datum des vorangegangenen Freitags)
Ins Blatt eins springen, sollte die letzte volle Zelle der Spalte B die Zeile 30 nicht überschreiten dann die Seite 1 bis 1 drucken, sollte die die letzte volle Zelle zwischen 31 und 60 sein die Seite 2 bis 2 drucken usw.
Zurück ins 2te Blatt springen und auf die erste leere Zelle der Spalte B stellen.
Speichern und schließen.
Die Dateien sowie die dazugehörigen Tabellenblätter heissen immer anders.
Will aber nur ein Makro für alle Dateien (da es über 100 sind).
Gehts das?

Herzlichen Dank für eure Unterstützung!
Bernhard

Bild


Betrifft: AW: Makro mit gestrigem Datum und Blattwechsel von: Harald E
Geschrieben am: 22.03.2005 09:16:13

Hallo Bernhard,

hoffe ich hab die Aufgabenstellung richtig erkannt. Der Code ist zwar nicht der Schönste, aber ich hab ja auch kein vba-gut im Level ;-))
Zumindest ist er getestet und läuft bei mir ohne Fehlermeldung.


Sub Bernhard()
'erste freie zelle in Spalte B
i = Sheets(2).Cells(Rows.Count, 2).End(xlUp).Row + 1
'wenn Montag dann Heute minus 3, sonst Heute minus 1
If Format(Date, "dddd") = "Montag" Then
Cells(i, 2).Value = Date - 3
Else:
Cells(i, 2).Value = Date - 1
End If
'Seite drucken entsprechend letzter Zeilenummer in B
letz = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
If letz < 30 Then
Sheets(1).PrintOut From:=1, To:=1, Copies:=1, Collate _
        :=True
End If
If letz >= 30 And letz < 60 Then
Sheets(1).PrintOut From:=2, To:=2, Copies:=1, Collate _
        :=True
End If
'Blatt 2 letzte Zelle in Spalte B, Datei speichern und schliessen
Sheets(2).Activate
Cells(i, 2).Select
With ActiveWorkbook
.Save
.Close
End With
End Sub


Gruß
Harald


Bild


Betrifft: AW: Makro mit gestrigem Datum und Blattwechsel von: UweD
Geschrieben am: 22.03.2005 09:19:30

Hallo Bernhard


Erzeuge dir im VBE in der Personl.xls ein neues Modul und kopier dort das Makro rein (Steht dann für alle Dateien zu Verfügung)




      
Option Explicit

Sub Bernhard()
    
Dim TB1, TB2, Gest As Date, LB%
    
Set TB1 = Sheets("Tabelle1")
    
Set TB2 = Sheets("Tabelle2")
        LB = TB2.Cells(Rows.Count, 2).End(xlUp).Row 
'letzte Zeile der Spalte B
        If Weekday(Date, 2) = 1 Then 'Wenn Monatg dann Gestern=Freitag
            Gest = Date - 3
        
Else
            Gest = Date - 1
        
End If
        TB2.Cells(LB + 1, 2).Value = Gest
        LB = TB1.Cells(Rows.Count, 2).End(xlUp).Row 
'letzte Zeile der Spalte B
        If LB <= 30 Then
            TB1.PrintOut From:=1, To:=1, Collate:=
True
        
ElseIf LB >= 31 And LB < 60 Then
            TB1.PrintOut From:=2, To:=2, Collate:=
True
        
Else
            MsgBox 
"Mehr als 60 Zeilen vorhanden." & Chr(13) & Chr(13) & _
                
"Es erfolgt kein Ausdruck."
        
End If
End Sub 




Gruß UweD


Bild


Betrifft: AW: Makro mit gestrigem Datum und Blattwechsel von: UweD
Geschrieben am: 22.03.2005 09:31:52

Hi

Harald war schneller und ich hab ja die Hälfte noch vergessen.


Hier der Vollständigkeit halber nochmal mit dem Rest.



      
Option Explicit

Sub Bernhard()
    
Dim TB1, TB2, Gest As Date, LB2%, LB1%
    
Set TB1 = Sheets("Tabelle1")
    
Set TB2 = Sheets("Tabelle2")
    LB2 = TB2.Cells(Rows.Count, 2).End(xlUp).Row 
'letzte Zeile der Spalte B aus TB2
    If Weekday(Date, 2) = 1 Then 'Wenn Monatg dann Gestern=Freitag
        Gest = Date - 3
    
Else
        Gest = Date - 1
    
End If
    TB2.Cells(LB2 + 1, 2).Value = Gest
    LB1 = TB1.Cells(Rows.Count, 2).End(xlUp).Row 
'letzte Zeile der Spalte B aus TB1
    If LB1 <= 30 Then
        TB1.PrintOut From:=1, To:=1, Collate:=
True
    
ElseIf LB1 > 30 And LB1 <= 60 Then
        TB1.PrintOut From:=2, To:=2, Collate:=
True
    
Else
        MsgBox 
"Mehr als 60 Zeilen vorhanden." & Chr(13) & Chr(13) & _
            
"Es erfolgt kein Ausdruck."
    
End If
    TB2.Activate
    TB2.Cells(LB2 + 2).Select
    ActiveWorkbook.Close Savechanges:=
True
End Sub 



Gruß UweD


Bild


Betrifft: Herzlichen Dank von: wagner
Geschrieben am: 22.03.2005 21:46:31

Herzlichen Dank für eure Hilfe!
Ein paar kleine Anpassungen und es hat super funktioniert
Bernhard


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Makro mit gestrigem Datum und Blattwechsel"