VBA - Datumsbereich markieren und in anderes Blatt kopieren

[atilla]

Hallo,

Hab gerade gesehen, dass Du zwischenzeitlich eine Datei eingestellt hast.
Dann ersetze Deinen Code hinter der Userform mit diesem:

Code:

Private Sub CommandButton1_Click()
Dim lngLast As Long

   With Sheets("Tabelle2")
      .Cells.Clear
      .Range("A1:B1") = Worksheets("Auswertung-Eingabe").Range("D1").Value
      .Range("A2") = ">=" & Format(TextBox1.Text, "YYYY-MM-DD")
      .Range("B2") = ">=" & Format(TextBox2.Text, "YYYY-MM-DD")
   End With
  
   With Worksheets("Auswertung-Eingabe")
      lngLast = .Cells(.Rows.Count, 4).End(xlUp).Row
      .Range("D1:J" & lngLast).AdvancedFilter Action:= _
           xlFilterCopy, CriteriaRange:=Sheets("Tabelle2").Range("A1:B2"), CopyToRange:=Sheets("Tabelle2").Range("A5"), _
           Unique:=False
   End With
  
End Sub

Den Druckbereich musst Du dann ab a5 anpassen, könnte auch per Code geregelt werden.

[atilla]

Hallo,


so mit Druckbereich ab A5 und Vorgaben, die erfüllt sein müssen:

Code:

Private Sub CommandButton1_Click()
   Dim lngLast As Long

   If TextBox1 <> "" Or TextBox2 <> "" Then
      With Sheets("Tabelle2")
         .Cells.Clear
         .Range("A1:B1") = Worksheets("Auswertung-Eingabe").Range("D1").Value
         If TextBox1 <> "" Then .Range("A2") = ">=" & Format(TextBox1.Text, "YYYY-MM-DD")
         If TextBox2 <> "" Then .Range("B2") = ">=" & Format(TextBox2.Text, "YYYY-MM-DD")
      End With
      
      With Worksheets("Auswertung-Eingabe")
         lngLast = .Cells(.Rows.Count, 4).End(xlUp).Row
         .Range("D1:J" & lngLast).AdvancedFilter Action:= _
              xlFilterCopy, CriteriaRange:=Sheets("Tabelle2").Range("A1:B2"), CopyToRange:=Sheets("Tabelle2").Range("A5"), _
              Unique:=False
      End With
      
      With Sheets("Tabelle2")
         lngLast = .Cells(.Rows.Count, 1).End(xlUp).Row
         .PageSetup.PrintArea = "$A$5:$C$" & lngLast
      End With
   End If
  
End Sub

[HannesBo]

Hi,

ich bin dran.
Hast Du die Spalten "A:C" gelöscht, oder sind diese auch in Deiner kompletten Version leer?

Gruß
Max

Hi Max,

die Spalten A:C sind bewusst gelöscht.
Auch in der kompletten Version sind die leer.

[HannesBo]

Hallo,


so mit Druckbereich ab A5 und Vorgaben, die erfüllt sein müssen:

Code:

Private Sub CommandButton1_Click()
   Dim lngLast As Long

   If TextBox1 <> "" Or TextBox2 <> "" Then
      With Sheets("Tabelle2")
         .Cells.Clear
         .Range("A1:B1") = Worksheets("Auswertung-Eingabe").Range("D1").Value
         If TextBox1 <> "" Then .Range("A2") = ">=" & Format(TextBox1.Text, "YYYY-MM-DD")
         If TextBox2 <> "" Then .Range("B2") = ">=" & Format(TextBox2.Text, "YYYY-MM-DD")
      End With
      
      With Worksheets("Auswertung-Eingabe")
         lngLast = .Cells(.Rows.Count, 4).End(xlUp).Row
         .Range("D1:J" & lngLast).AdvancedFilter Action:= _
              xlFilterCopy, CriteriaRange:=Sheets("Tabelle2").Range("A1:B2"), CopyToRange:=Sheets("Tabelle2").Range("A5"), _
              Unique:=False
      End With
      
      With Sheets("Tabelle2")
         lngLast = .Cells(.Rows.Count, 1).End(xlUp).Row
         .PageSetup.PrintArea = "$A$5:$C$" & lngLast
      End With
   End If
  
End Sub

Hab den Code mal ersetzt, funktioniert aber auch nicht so wie ich möchte.

Gebe ich zum Beispiel 1.2 und 6.5 ein, listet er mir die Werte bzw. Zeilen vom 09.05.2014 an.
Und das auch dann wenn ich einen anderen Bereich angebe. Komisch?
Geht also nicht! Trotzdem Danke für die Mühe!

[HannesBo]

Hallo,


so mit Druckbereich ab A5 und Vorgaben, die erfüllt sein müssen:

Code:

Private Sub CommandButton1_Click()
   Dim lngLast As Long

   If TextBox1 <> "" Or TextBox2 <> "" Then
      With Sheets("Tabelle2")
         .Cells.Clear
         .Range("A1:B1") = Worksheets("Auswertung-Eingabe").Range("D1").Value
         If TextBox1 <> "" Then .Range("A2") = ">=" & Format(TextBox1.Text, "YYYY-MM-DD")
         If TextBox2 <> "" Then .Range("B2") = ">=" & Format(TextBox2.Text, "YYYY-MM-DD")
      End With
      
      With Worksheets("Auswertung-Eingabe")
         lngLast = .Cells(.Rows.Count, 4).End(xlUp).Row
         .Range("D1:J" & lngLast).AdvancedFilter Action:= _
              xlFilterCopy, CriteriaRange:=Sheets("Tabelle2").Range("A1:B2"), CopyToRange:=Sheets("Tabelle2").Range("A5"), _
              Unique:=False
      End With
      
      With Sheets("Tabelle2")
         lngLast = .Cells(.Rows.Count, 1).End(xlUp).Row
         .PageSetup.PrintArea = "$A$5:$C$" & lngLast
      End With
   End If
  
End Sub

Hab den Code mal ersetzt, funktioniert aber auch nicht so wie ich möchte.

Gebe ich zum Beispiel 1.2 und 6.5 ein, listet er mir die Werte bzw. Zeilen vom 09.05.2014 an.
Und das auch dann wenn ich einen anderen Bereich angebe. Komisch?
Geht also nicht! Trotzdem Danke für die Mühe!

Noch mal anderen Wert eingegeben...Textbox1 = 1.5 und Textbox2 = 1.8

er listet dann ab 1.5 bis Ende des Jahres, alles davor wird gelöscht.
Ich will aber den Bereich zwischen den beiden Daten haben.

[atilla]

Hallo,

hab mit Copy Paste einen Fehler eingebaut.

diese Zeile im Code:

If TextBox2 <> "" Then .Range("B2") = ">=" & Format(TextBox2.Text, "YYYY-MM-DD")

muss so lauten:

If TextBox2 <> "" Then .Range("B2") = "<=" & Format(TextBox2.Text, "YYYY-MM-DD")


Und für den Druckbereich so:

.PageSetup.PrintArea = "$A$5:$J$" & lngLast

[HannesBo]

Hallo,

hab mit Copy Paste einen Fehler eingebaut.

diese Zeile im Code:

If TextBox2 <> "" Then .Range("B2") = ">=" & Format(TextBox2.Text, "YYYY-MM-DD")

muss so lauten:

If TextBox2 <> "" Then .Range("B2") = "<=" & Format(TextBox2.Text, "YYYY-MM-DD")


Und für den Druckbereich so:

.PageSetup.PrintArea = "$A$5:$J$" & lngLast

Hi atilla,

besten Dank!!! Das funktioniert so wie ich es haben möchte.
Tausend Dank...jetzt bin ich schon ein erhebliches Stück weiter...

Und auch vielen Dank an Max...

Danke euch!!!:28:28:15:

Sollte man sich nicht mehr vor dem Jahreswechsel im Forum begegnen wünsche ich euch einen guten Rutsch ins neue Jahr und zudem Gesundheit und viel Erfolg in allem was ihr euch für das kommende Jahr vorgenommen habt.

[Max]

Hi,

so sollte es gehen.


  Pearseri_Max.xlsm (Größe: 27,33 KB / Downloads: 22)

Gruß
Max