Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 21:55:37
Preiserhöhung über mehrere Jahre berechnen
17.04.2024 20:19:32
Endzeitpunkt berechnen aus d:hh:mm errechnen
17.04.2024 18:57:33
Errinnerungsfunktion
17.04.2024 16:56:58
Stunden addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
712to716
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
712to716
712to716
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

SuchMacro

SuchMacro
28.12.2005 15:00:31
Lucien
Hallo und guten Nachmittag
Ich habe eine Mappe mit den Sheets von A -Z benannt sind.
Ich möcht dass Excel nun in das Sheet A geht und dort die ganze Tabelle nach abgelaufenden Datum sucht z.b. 01.07.2005 (alles was älter ist als 1 Monat) dann die ganze Zeile wo das abgelaufende Datum steht nach Blatt mit dem Namen AG kopiert.
Dann das Blatt B u.s.w. bis Z
Wer kann mir dabei helfen?
Danke und gruss Lucien

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

Betreff
Datum
Anwender
Anzeige
AW: SuchMacro
28.12.2005 16:55:12
Unbekannter
Wo steht das Datum in den jeweiligen Sheets?
Gruß UN1
AW: SuchMacro
28.12.2005 17:15:17
Lucien
Hallo
Das Datum steht immer in der Reihe B
gruss Lucien
AW: SuchMacro
28.12.2005 20:13:18
Unbekannter
Schau es dir mal an.

Sub datum_rüber()
For a = 1 To Sheets.Count
If Sheets(a).Name <> "AG" Then
For b = 1 To Sheets(a).Cells(Rows.Count, 2).End(xlUp).Row
If (Sheets(a).Cells(b, 2) - Date) / 30 <= -1 Then
c = c + 1
Sheets(a).Rows(b).Copy: Sheets("AG").Rows(c).PasteSpecial
End If: Next b
End If: Next a
End Sub

Gruß UN1
AW: SuchMacro
28.12.2005 20:42:19
Peter
Hallo Lucien,
so sollte es gehen:


'
'   ein Datum älter als einen Monat vor dem aktuellen Datum finden
'   und alle Zeilen der Tabellen-Blätter A - Z in das Tabellen-Blatt
'   AG kopieren.
'
Sub Altes_Datum()
Dim sBl_Namen()   As Variant
Dim dFind         As Date
Dim iCount        As Integer
Dim WkSh_V        As Worksheet
Dim WkSh_N        As Worksheet
Dim lLetzte_V     As Long
Dim lLetzte_N     As Long
Dim lZeile        As Long
   On Error Resume Next
   
   Application.ScreenUpdating = False
   sBl_Namen = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", _
                     "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", _
                     "U", "V", "W", "X", "Y", "Z")
                       
   If Month(Date) > 1 Then
      dFind = Day(Date) & "." & Month(Date) - 1 & "." & Year(Date)
    Else
      dFind = Day(Date) & "." & Month(Date) - 1 & "." & Year(Date) - 1
   End If
   
   Set WkSh_N = Worksheets("AG")
   lLetzte_N = IIf(WkSh_N.Range("B65536") <> "", 65536, WkSh_N.Range("B65536").End(xlUp).Row)
   For iCount = 0 To UBound(sBl_Namen)
      Set WkSh_V = Worksheets(sBl_Namen(iCount))
      If Err.Number = 9 Then GoTo Blatt_fehlt
      lLetzte_V = IIf(WkSh_V.Range("B65536") <> "", 65536, WkSh_V.Range("B65536").End(xlUp).Row)
      For lZeile = 1 To lLetzte_V
         If IsDate(WkSh_V.Range("B" & lZeile).Value) And _
            WkSh_V.Range("B" & lZeile).Value < dFind Then
            WkSh_V.Rows(lZeile).EntireRow.Copy: Worksheets("AG").Rows(lLetzte_N).PasteSpecial
            lLetzte_N = lLetzte_N + 1
         End If
Blatt_fehlt:
      Next lZeile
   Next iCount
   
   Application.ScreenUpdating = True
End Sub


Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.
Anzeige
AW: SuchMacro
28.12.2005 20:55:28
Peter
Hallo Lucien,
so ist es ein ganz klein wenig sicherer:


'
'   ein Datum älter als einen Monat vor dem aktuellen Datum in der
'   Spalte B finden und alle Zeilen der Tabellen-Blätter A - Z in
'   denen das Datum gefunden wird in das Tabellen-Blatt AG kopieren.
'
Sub Altes_Datum()
Dim sBl_Namen()   As Variant
Dim dFind         As Date
Dim iCount        As Integer
Dim WkSh_V        As Worksheet
Dim WkSh_N        As Worksheet
Dim lLetzte_V     As Long
Dim lLetzte_N     As Long
Dim lZeile        As Long
   On Error Resume Next
   
   Application.ScreenUpdating = False
   sBl_Namen = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", _
                     "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", _
                     "U", "V", "W", "X", "Y", "Z")
                       
   If Month(Date) > 1 Then
      dFind = Day(Date) & "." & Month(Date) - 1 & "." & Year(Date)
    Else
      dFind = Day(Date) & "." & Month(Date) - 1 & "." & Year(Date) - 1
   End If
   
   Set WkSh_N = Worksheets("AG")
   lLetzte_N = IIf(WkSh_N.Range("B65536") <> "", 65536, WkSh_N.Range("B65536").End(xlUp).Row)
   WkSh_N.Range("A1:IV" & lLetzte_N).ClearContents
   lLetzte_N = 1
   For iCount = 0 To UBound(sBl_Namen)
      Set WkSh_V = Worksheets(sBl_Namen(iCount))
      If Err.Number = 9 Then GoTo Blatt_fehlt
      lLetzte_V = IIf(WkSh_V.Range("B65536") <> "", 65536, WkSh_V.Range("B65536").End(xlUp).Row)
      For lZeile = 1 To lLetzte_V
         If IsDate(WkSh_V.Range("B" & lZeile).Value) And _
            WkSh_V.Range("B" & lZeile).Value < dFind Then
            WkSh_V.Rows(lZeile).EntireRow.Copy: Worksheets("AG").Rows(lLetzte_N).PasteSpecial
            lLetzte_N = lLetzte_N + 1
            WkSh_N.Range("A" & lLetzte_N).Activate
         End If
      Next lZeile
Blatt_fehlt:
   Next iCount
   
   Application.ScreenUpdating = True
End Sub


Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.
Anzeige
AW: SuchMacro
29.12.2005 08:16:23
Lucien
Hallo Peter
Das Makro blokiert hier
dFind = Day(Date) & "." & Month(Date) - 1 & "." & Year(Date)
Hat das vileicht etwas damit zu tun dass ich auf einem französichen Excel arbeite, wenn ja wie kann ich dann das Datumformat ändern Jetzt ist es hier bei mir 29/12/2005
Danke und gruss Lucien
AW: SuchMacro
29.12.2005 11:15:47
Peter
Hallo Lucien,
dann versuch doch mal die "." in "/" zu ändern, vielleicht hilft das.
Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.
AW: SuchMacro
30.12.2005 15:21:54
Lucien
Hallo Peter
Es funktioniert nun hervoragend
Danke nochmals und gruss Lucien
AW: SuchMacro
29.12.2005 07:39:18
Lucien
Hallo
Danke an euch beiden für eure Antwort, werde es gleich testen und euch Bescheid geben.
Gruss Lucien
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige