Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
588to592
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
588to592
588to592
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro mit gestrigem Datum und Blattwechsel

Makro mit gestrigem Datum und Blattwechsel
21.03.2005 21:49:51
wagner
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

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro mit gestrigem Datum und Blattwechsel
22.03.2005 09:16:13
Harald
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
Anzeige
AW: Makro mit gestrigem Datum und Blattwechsel
22.03.2005 09:19:30
UweD
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
Anzeige
AW: Makro mit gestrigem Datum und Blattwechsel
22.03.2005 09:31:52
UweD
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
Anzeige
Herzlichen Dank
22.03.2005 21:46:31
wagner
Herzlichen Dank für eure Hilfe!
Ein paar kleine Anpassungen und es hat super funktioniert
Bernhard

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige