Anzeige
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 Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

SuchMacro

Forumthread: 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
Anzeige

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
Anzeige
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
Anzeige
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)

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