Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 08:41:23
Zwei Makros in ein Arbeitsblatt - zweite wird nicht ausführt
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1244to1248
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
1244to1248
1244to1248
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Kopieren nach Datum

Kopieren nach Datum
Heinz
Hallo Leute
Ich habe unteres Makro das mir Sheets "Gesperrte Ware" nach Sheets "Drucken"kopiert.
Es werden immer die makierten Zellen in "Gesperrter Ware" kopiert.
Nun möchte ich es vereinfachen.
Im Sheets "Gesperrter Ware" stehen in Spalte A das Datum. (2 mal)
Ich hätte gerne das es die Spalte A absucht,und das Datum von Heute minus 1 (also gestern)
kopiert wird.
Das Datum in A steht immer zwei mal.
Z.B. In A45 & in A48 nun sollte der Bereich A45: J48 kopiert werden.
Immer von A-J
Hätte bitte jemand eine Hilfe anzubieten?
https://www.herber.de/bbs/user/78318.xls
Danke
Heinz
Option Explicit
Sub kopieren_Gesperrte() 'Gesperrte Ware
Application.ScreenUpdating = False
Dim ac As Long, a As Long
Dim shpShape As Shape
Application.ScreenUpdating = False
Sheets("Drucken").Range("A3:J50").ClearContents
Sheets("Drucken").Pictures.Delete
Sheets("Drucken").Range("A3:J50").Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Drucken").Range("A3:J50").Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("Drucken").Range("A3:J50").Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("Drucken").Range("A3:J50").Borders(xlEdgeTop).LineStyle = xlNone
Sheets("Drucken").Range("A3:J50").Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("Drucken").Range("A3:J50").Borders(xlEdgeRight).LineStyle = xlNone
Sheets("Drucken").Range("A3:J50").Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Drucken").Range("A3:J50").Borders(xlInsideHorizontal).LineStyle = xlNone
Sheets("Drucken").Range("A3:J50").Interior.ColorIndex = xlNone
Sheets("Drucken").Rows("4:151").RowHeight = 14.25
With Sheets("Drucken")
ac = IIf(IsEmpty(.Cells(Rows.Count, 4)), .Cells(Rows.Count, 7).End(xlUp).Row, . _
Rows.Count)
Sheets("Gesperrte Ware").Range("A1:J2").Copy .Cells(ac + 2, 1)
Selection.Copy .Cells(ac + 4, 1)
Sheets("Drucken").Shapes("MyArrow").Delete
Sheets("Drucken").Range("A3:J50").Rows.AutoFit
Sheets("Drucken").Range("A3:J50").Columns.AutoFit
Sheets("Drucken").Range("A3:J50").FormatConditions.Delete
End With
Application.ScreenUpdating = True
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Kopieren nach Datum
09.01.2012 17:00:14
Tino
Hallo,
im Beitrag schreibst Du, dass Du das Datum von gestern kopieren möchtest,
In Deiner Datei markierst Du das Datum von heute!
Was möchtest Du jetzt kopieren?
Hier mal ein Code für das Datum von gestern.
Es wird zuerst der erste Eintrag mit dem Datum von gestern gesucht,
dann wird eine Schleife durchlaufen bis das gleiche Datum nochmals auftaucht.
Sub kopieren_Gesperrte() 'Gesperrte Ware 
Dim rng As Range, n&
Dim RowDatumGestern

With Tabelle1.UsedRange
    RowDatumGestern = Application.Match(CLng(Date - 1), .Columns(1), 0)
    If IsNumeric(RowDatumGestern) Then
        Do
            n = n + 1
        Loop While .Cells(RowDatumGestern + n, 1) <> .Cells(RowDatumGestern, 1)
    Else
        MsgBox "Datum von gestern wurde nicht gefunden!", vbCritical
    End If
    
    With Tabelle4 'Zieltabelle 
       .Range("A5", .Cells(.Rows.Count, 10)).Clear
    End With
    
    If .Cells(RowDatumGestern + n, 1) = .Cells(RowDatumGestern, 1) Then
        .Cells(RowDatumGestern, 1).Resize(n + 1, 10).Copy Tabelle4.Range("A5")
    Else
        MsgBox "Datum von gestern nur einmal gefunden!", vbCritical
    End If
End With

End Sub
Gruß Tino
Anzeige
AW: Kopieren nach Datum
10.01.2012 08:56:06
Heinz
Hallo Tino 
im Beitrag schreibst Du, dass Du das Datum von gestern kopieren möchtest,

Natürlich hast du wieder recht.
Es funktioniert super.
Recht herzlichen Dank.
Gruß
Heinz

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige