Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1572to1576
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
Inhaltsverzeichnis

Zeilen mit bestimmten Datum in neues Tabellenblatt

Zeilen mit bestimmten Datum in neues Tabellenblatt
16.08.2017 11:07:37
Christian
Hallo Excel VBA Profis,
ich bin am Verzweifeln.
Nach stundelanger Suche in den Foren, findet ich keine passende Lösung.
Habe schon einiges versucht, auch zusammenkopierem von VBA Scripts um meienr lösung näher zu kommen. Aber jetzt hängts immer noch.
Ich möchte aus einer Tabelle, bestimmte Werte mit einem definierten Datum in eine neue Tabelle übergeben. (kopieren). Diese werde ich dann monatlich an eine Abteilung senden (Mail).
Leider klappt das "gefundene" Script aber nicht, ich hab es ergänzt um den kopierbefehl, aber es läuft auf fehler.
wer kann mir denn helfen...?
-------------------------------------
Sub Robert()
Dim c As Range, ErgBereich As Range, _
Mon As String, _
laR As Long, _
check As Boolean
Mon = InputBox(vbCr & vbCr & vbCr & "Gesuchter Monat:")
If Mon = "" Then check = True
If IsNumeric(Mon) Then
If Mon 12 Then check = True
Else
check = True
End If
If check = True Then
MsgBox "Keine oder falsche Eingabe !" & vbCr & vbCr & _
"Makro-Abbruch !", vbOKOnly + vbCritical, _
"Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
Application.ScreenUpdating = False
laR = Cells(Rows.Count, 11).End(xlUp).Row
For Each c In Range("A14:K100" & laR)
If IsDate(c.Text) Then
If Month(CDate(c.Text)) = Mon Then
Set ErgBereich = Rows(c.Row)
Exit For
End If
End If
Next c
If ErgBereich Is Nothing Then
MsgBox "Nichts gefunden !", vbOKOnly + vbInformation, _
"Dezenter Hinweis für " & Application.UserName & ":"
Else
For Each c In Range("A14:K20" & laR)
If IsDate(c.Text) Then
If Month(CDate(c.Text)) = Mon Then
Set ErgBereich = Application.Union(ErgBereich, Rows(c.Row))
End If
End If
Next c
ErgBereich.Select
Set ErgBereich = Nothing
End If
Application.ScreenUpdating = True
Application.CutCopyMode = False
Selection.copy
Sheets("Datenlieferung_ITGBA01_Kopier").Select
Range("A:A").Select
ActiveSheet.SelectionPaste
---------------------------------------------------

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilen mit bestimmten Datum in neues Tabellenblatt
16.08.2017 12:56:14
Christian
Hallo Forumsgemeinde,
hab es jetzt einigermaßen hinbekommen, aber es läuft eeeeewig....kann man das auch beschleunigen?
Wer kann mir denn helfen...?
https://www.herber.de/bbs/user/115516.xlsx
-----------------------------
Sub Abrechnung_je_Monat()
Dim c As Range, ErgBereich As Range, _
Mon As String, _
laR As Long, _
check As Boolean
Workbooks("Kalkulation_Copyshop.xlsm").Worksheets("Datenlieferung_ITGBA01_Kopier").Range(" _
A2:A100").EntireRow.Delete
Worksheets("AlleAufträge").Activate
Mon = InputBox(vbCr & vbCr & vbCr & "Bitte den Monat eingeben, für den die Abrechnung  _
erzeugt werden soll (1 - 12)" & vbNewLine & vbNewLine & " Der Lauf kann bis zu 3 min. dauern")
If Mon = "" Then check = True
If IsNumeric(Mon) Then
If Mon  12 Then check = True
Else
check = True
End If
If check = True Then
MsgBox "Keine oder falsche Eingabe !" & vbCr & vbCr & _
"Makro-Abbruch !", vbOKOnly + vbCritical, _
"Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
Application.ScreenUpdating = False
laR = Cells(Rows.Count, 11).End(xlUp).Row
For Each c In Range("A5:K200" & laR)
If IsDate(c.Text) Then
If Month(CDate(c.Text)) = Mon Then
Set ErgBereich = Rows(c.Row)
Exit For
End If
End If
Next c
If ErgBereich Is Nothing Then
MsgBox "Nichts gefunden !", vbOKOnly + vbInformation, _
"Dezenter Hinweis für " & Application.UserName & ":"
Else
For Each c In Range("A5:K200" & laR)
If IsDate(c.Text) Then
If Month(CDate(c.Text)) = Mon Then
Set ErgBereich = Application.Union(ErgBereich, Rows(c.Row))
End If
End If
Next c
ErgBereich.copy
ActiveSheet.Paste Destination:=Worksheets("Datenlieferung_ITGBA01_Kopier").Range("A2:K200" _
)
End If
Application.ScreenUpdating = True
Application.CutCopyMode = False
Set ErgBereich = Nothing
MsgBox ("Die Abrechnungsdaten wurden erzeugt. Bitte schauen Sie Tabelle: [ _
Datenlieferung_ITGBA01_Kopier] an")
Worksheets("Datenlieferung_ITGBA01_Kopier").Activate
End Sub
-------------------------------------------------
Anzeige
AW: Zeilen mit bestimmten Datum in neues Tabellenblatt
16.08.2017 13:49:39
ChrisL
Hi Christian
laR = Cells(Rows.Count, 11).End(xlUp).Row
For Each c In Range("A5:K200" & laR)
1. machst du die Suche über alle Spalten obwohl Spalte K vermutlich reichen würde
2. Wenn laR = 100, dann ergibt K200&laR die zeile 200100
somit...
laR = Cells(Rows.Count, 11).End(xlUp).Row
For Each c In Range("K5:K" & laR)
Schliesslich solltest du noch die beiden For...Next Schleifen auf eine Schliefe reduzieren.
cu
Chris
AW: Zeilen mit bestimmten Datum in neues Tabellenblatt
17.08.2017 07:35:19
Christian
Hallo Chris,
Vielen Dank, habe sofort die Zeile ausgetauscht. Es geht schon schneller, dauert aber immer noch lange.
Wenn ich VBA verstehen würde, dann würde ich sehr gerne das vorgeschlagene umsetzen. Leider jedoch beschränken sich meine VBA Kenntnisse auf das suchen von Lösungen, und austauschen von Zellbezügen :-)....wie gerne würde ich das alles können.
Vielleicht hat noch jemand ein paar Minuten, mir beim austauschen der For...Next Schleifen zu helfen?
Vielen lieben Dank!!!!
Grüße
Christian
Anzeige
AW: Zeilen mit bestimmten Datum in neues Tabellenblatt
17.08.2017 07:45:49
Christian
Hallo Chris,
habe soeben festgestellt, das ich nur einmal die Zeile austauschte. Aber Sie war ja als zweite Schleife nochmal mit dem K enthalten.....jetzt rennt es wie die Sau :-)))))))
Vielen Dank
Die FOR Schleife lasse ich dann...Hauptsache es geht :-)
Danke!!!!!
Christian

314 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige