Office 2003: Mit Wenn-Abfrage makro starten

[mexico67]

Hallo
ich bitte um Eure geschätzte Hilfe bei meinem Problem.

Bestand: Tabelle mit mehreren Spalten und Zeilen
z.B. Spalte A=Vorname;B=Nachname;c=Datum;D=Uhrzeit
in Spalte " Datum " sind mehrerre Datum gelistet
wenn nun das aktuelle Datum kommt soll ein neues Tabellenblatt z.B. " Aktuell "in der Tabelle angelegt werden. In diesem neuen Tabellenblatt sollen nur die Spalten und Zeilen gelistet werden in welcher sich das aktuelle Datum befindet.

Selber kreiert habe ich schon die Abfrage allerdings in einem manuell erstellten neuen Tabellenblatt =wenn(c2=heute();a2;0)=wenn(c2=heute();b2;0)=wenn(c2=heute();d2;0)
Ich habe zwar von Ihrem Makro/Funktion-Code gelesen, kann Ihn aber nicht umsetzten, da ich von VBA keine Ahnung ( Vorgang) habe
Ich würde mich freuen, wenn Sie mir helfen könnten.
Besten Dank im Vorraus
Viele Grüße
Mexico67

[mexico67]

Kann mir denn da niemand helfen ?

Gruß Mexico67

[Beverly]

Hi,

kopiere folgenden Code ins Codemodul "DieseArbeitsmappe":

Code: [Auswählen]

Private Sub Workbook_Open()
   Dim wksTab As Worksheet
   Dim blnVorhanden As Boolean
   Dim lngZeile As Long
   Dim lngErste As Long
   lngZeile = 2
   ' prüfen ob Tabellenblatt aktuelles Datum schon vorhanden
   For Each wksTab In Worksheets
      If wksTab.Name = Date Then
         blnVorhanden = True
         Exit For
      End If
   Next wksTab
   ' Tabellenblatt aktuelles Datum noch nicht vorhanden
   If blnVorhanden = False Then
      ' neues Tabellenblatt erstellen
      With Worksheets.Add
         ' Name aktuelles Datum
         .Name = Date
         ' ans Ende stellen
         .Move after:=Worksheets(Worksheets.Count)
         ' Überschrift der Spalten A:D kopieren
         Worksheets("Tabelle1").Range("A1:D1").Copy .Range("A1")
         ' Schleife über alle Zeilen des Ausgangstabellenblattes
         Do
            ' in Spalte C steht das aktuelle Datum
            If Worksheets("Tabelle1").Cells(lngZeile, 3) = Date Then
               ' erste freie Zeile im Tabellenblatt des aktuellen Datums ermitteln
               lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
               ' Bereich A:D der laufenden Zeile ins Tabellenblatt aktuelles Datum kopieren
               Worksheets("Tabelle1").Range("A" & lngZeile & ":D" & lngZeile).Copy .Cells(lngErste, 1)
            End If
            lngZeile = lngZeile + 1
         Loop While Worksheets("Tabelle1").Cells(lngZeile, 1) <> ""
      End With
   End If
End Sub

Beim Öffnen der Arbeitsmappe wird geprüft, ob es ein Tabellenblatt gibt, welches den Namen des aktuellen Datums hat. Wenn nicht, wird ein neues Tabellenblatt mit dem entsprechenden Namen angelegt und alle Daten der Spalten A:D aus dem Tabellenblatt "Tabelle1" in dieses neue Tabellenblatt kopiert, wenn in Spalte D das aktuelle Datum vorkommt.

Bis später,
Karin

[mexico67]

Hallo Karin,
vielen Dank daß Sie sich meinem Problem annehmen. Aber bitte entschuldigen Sie, ich habe bis jetzt noch nie was mit VBA gemacht, deswegen weiß ich nicht wo ich, wie ich ein Code-Modul erstellen/anlegen kann und wie es danach weiter geht.
Ist schon ein Code-Modul bei meiner Tabelle/Arbeitsblatt schon kreiert??
Muß ich das Code-Modul, wenn ich Ihren Code hineinkopiert habe abspeichern ??
Vielen Dak für Ihre Bemühungen
Viele Grüße aus dem Schwarzwald
Mexico67

[Officer]

Hallo mexico67,

öffne mit der Tastenkombinatino [Alt] + [F11] den VBA-Editor. Dort findest Du im VBA-Explorer das Code-Modul "DieseArbeitsmappe". Dort fügst Du den von Beverly geposteten VBA-Code ein. Der Code wird beim Starten der Arbeitsmappe ausgeführt.

Gruß

Officer

[mexico67]

Hallo Beverly & Officer

vielen , vielen Dank für Eure Hilfe. Habe alles kopiert und es funktioniert auch.
Wenn das aktuelle Datum kommt, wird ein neues Tabellenblatt mit dem Blattnamen z.B. " 4.4.2012" angelegt, und die Überschrift der Zeile 1 vom vorhandenen Tabellenblatt (A1=Nr;B1=Vorname;C1=Name;D1=Datum) in das neue Tabellenblatt kopiert.
Leider werden die Werte in den anderen Zeilen ( A2 bis z.B A50 ; B2:B50 usw. nicht kopiert, wenn in "D2:D50" irgend wo noch das aktuelle Datum steht.
Deswegen bitte ich nochmal um Eure geschätzte Hilfe
Vielen Dank
Mexico 67

[mexico67]

Hallo Beverly
Komando zurück, habe mir den Code näher angeschaut und kleine Änderungen vorgenommen, da die Beschreibung des Codes super ist. Habe " Tabelle1" in den entsprechenden Tabellennamen geändert. Jetzt funktioniert alles.

Trotzdem tauchen noch neue Fragen auf:
Was muß ich im Code ändern, daß im neuen Tabellenblatt zwei oder drei Überschriften stehen, also z.B. von A1:D1; und von A2:D2;und von A3:D3 ?
Das muß was mit "Worksheets("Tabelle1").Range("A1:D1").Copy .Range("A1") zu tun haben, da ich mal A1:D1  in A2:D2  ausgetauscht habe, dann wurden die Werte von A2:D2 eingetragen.

Wie muß der Code verändert werden, daß das Format des Tabellenblattes in das neue Tabellenblatt übernommen ( kopiert) wird ?

Noch eine andere Frage:
Wie wird eine Zahl einer Zeile fest zugeordnet ?
z.B. die Zahl 10 in A10 der Zeile 10;  oder die Zahl 60 in A15 für die Zeile 15


Darf ich nochmals um Deine oder Eure geschätzte Hilfe bitten

Viele Grüße
mexico 67

[mexico67]

Hallo Beverly,

Was muß ich im Code ändern, daß im neuen Tabellenblatt zwei oder drei Überschriften stehen, also z.B. von A1:D1; und von A2:D2;und von A3:D3 ?

nach logischem Überlegen, habe ich es geschafft die Überschrift von zwei Zeilen zu kopieren. Im Code habe ich nochmal Ihre Zeile mit den entsprechenden Feldern eingefügt.
' Überschrift der Spalten A:L kopieren
         Worksheets("Patienten").Range("A1:L1").Copy .Range("A1")
         Worksheets("Patienten").Range("A2:L2").Copy .Range("A2")

Bleibt zur Zeit nur noch die Frage mit der Formatierung (gleiche Spalten und Zeilenbreite) kopieren ins neue Tabellenblatt und
die feste Zuweisung einer Nummer für eine Zeile übrig.
Ich möchte gern eine neue fortlaufende Zeilennummer über einen Butten kreieren.
Wie muß dann das Makro aussehen Wie ich den Butten mit dem Makro verknüpfe, weiß ich, oder ist es möglich, sobald der Kursor in Feld z.B. "A15" ist und dort klickt, die neue fortlaufende Zeilennummer angelegt wird ?
Viele Grüße und frohe Ostern
Mexico67

[mexico67]

Hallo Beverly,
vielen Dank nochmal für Deine Hilfe bei meinem Problem " Mit Wenn-Abfrage Makro starten" funktioniert nach Anpassung (mehrere Spalten und Zeilen) auf meine Belange hervorragend.
Um das Ergebnis zu vervollständigen, fehlt noch, daß das Format der Tabelle mit in das neue Tabellenblatt kopiert wird.
Wie muß das Makro ergänzt werden ?
Viele Grüße
Mexico67

[mexico67]

Hallo Officer & Ricco

Hallo mexico67,

öffne mit der Tastenkombinatino [Alt] + [F11] den VBA-Editor. Dort findest Du im VBA-Explorer das Code-Modul "DieseArbeitsmappe". Dort fügst Du den von Beverly geposteten VBA-Code ein. Der Code wird beim Starten der Arbeitsmappe ausgeführt.

Gruß

Officer

ich brauche nochmal Eure geschätzte Hilfe.
Der Code von " Beverly " funktioniert einwandfrei, aber leider wird das Format der vorhandenen Tabelle nicht mit kopiert. Welche Ergänzung fehlt inn dem Code ??

Private Sub Workbook_Open()
   Dim wksTab As Worksheet
   Dim blnVorhanden As Boolean
   Dim lngZeile As Long
   Dim lngErste As Long
   lngZeile = 2
   ' prüfen ob Tabellenblatt aktuelles Datum schon vorhanden
   For Each wksTab In Worksheets
      If wksTab.Name = Date Then
         blnVorhanden = True
         Exit For
      End If
   Next wksTab
   ' Tabellenblatt aktuelles Datum noch nicht vorhanden
   If blnVorhanden = False Then
      ' neues Tabellenblatt erstellen
      With Worksheets.Add
         ' Name aktuelles Datum
         .Name = Date
         ' ans Ende stellen
         .Move after:=Worksheets(Worksheets.Count)
         ' Überschrift der Spalten A:D kopieren
         Worksheets("Tabelle1").Range("A1:D1").Copy .Range("A1")
         ' Schleife über alle Zeilen des Ausgangstabellenblattes
         Do
            ' in Spalte C steht das aktuelle Datum
            If Worksheets("Tabelle1").Cells(lngZeile, 3) = Date Then
               ' erste freie Zeile im Tabellenblatt des aktuellen Datums ermitteln
               lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
               ' Bereich A:D der laufenden Zeile ins Tabellenblatt aktuelles Datum kopieren
               Worksheets("Tabelle1").Range("A" & lngZeile & "" & lngZeile).Copy .Cells(lngErste, 1)
            End If
            lngZeile = lngZeile + 1
         Loop While Worksheets("Tabelle1").Cells(lngZeile, 1) <> ""
      End With
   End If
End Sub

Vielen Dank für eure Hilfe

VG Mexico67

[mexico67]

Hallo Officer & Ricco,
leider komme ich da nicht weiter

Code: [Auswählen]

ich brauche nochmal Eure geschätzte Hilfe.
Der Code von " Beverly " funktioniert einwandfrei, aber leider wird das Format der vorhandenen Tabelle nicht mit kopiert. Welche Ergänzung fehlt in dem Code ??

Zitat
Private Sub Workbook_Open()
   Dim wksTab As Worksheet
   Dim blnVorhanden As Boolean
   Dim lngZeile As Long
   Dim lngErste As Long
   lngZeile = 2
   ' prüfen ob Tabellenblatt aktuelles Datum schon vorhanden
   For Each wksTab In Worksheets
      If wksTab.Name = Date Then
         blnVorhanden = True
         Exit For
      End If
   Next wksTab
   ' Tabellenblatt aktuelles Datum noch nicht vorhanden
   If blnVorhanden = False Then
      ' neues Tabellenblatt erstellen
      With Worksheets.Add
         ' Name aktuelles Datum
         .Name = Date
         ' ans Ende stellen
         .Move after:=Worksheets(Worksheets.Count)
         ' Überschrift der Spalten A:D kopieren
         Worksheets("Tabelle1").Range("A1:D1").Copy .Range("A1")
         ' Schleife über alle Zeilen des Ausgangstabellenblattes
         Do
            ' in Spalte C steht das aktuelle Datum
            If Worksheets("Tabelle1").Cells(lngZeile, 3) = Date Then
               ' erste freie Zeile im Tabellenblatt des aktuellen Datums ermitteln
               lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
               ' Bereich A:D der laufenden Zeile ins Tabellenblatt aktuelles Datum kopieren
               Worksheets("Tabelle1").Range("A" & lngZeile & "" & lngZeile).Copy .Cells(lngErste, 1)
            End If
            lngZeile = lngZeile + 1
         Loop While Worksheets("Tabelle1").Cells(lngZeile, 1) <> ""
      End With
   End If
End Sub
Vielen Dank für eure Hilfe

Vielen Dank für Eure Hilfe
Viele Grüße
Mexico67