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
700to704
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
700to704
700to704
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Monatsabfrage + kopieren von diesen Daten

Monatsabfrage + kopieren von diesen Daten
01.12.2005 15:08:06
diesen
Hallo Excel-Spezialisten,
ich brauche eine Auswahlabfrage für den Monat und dann eine Routine, die mir nur die Zeilen des abgefragten Monats kopiert und in eine neue Datei einfügt.
Hier die Datei: https://www.herber.de/bbs/user/28891.xls
Am besten, Ihr schaut Euch den hinteren Teil des Makros nicht so genau an, ist ein bißchen zusammengebastelt...
Es geht um die Kassenberichtsdatei von unserem Verein, in die laufend alles eingetragen wird. Zu jedem Monatsende brauchen wir einen Auszug daraus, wofür ich ein Makro gemacht habe, das alles in eine neue Datei kopiert und alles mögliche weitere.
Da ich nicht wußte, wie ich die richtigen Zeilen automatisch ansprechen kann, machen wir es jetzt so, daß alle Zeilen, um die es nicht geht, von Hand gelöscht werden, dann der gesamte Rest per Makro in die neue Datei kopiert wird.
Das ist leider fehleranfällig und auch lästig. Wie müßte ich den Anfang des Makros verändern, damit ich diese Abfrage bekomme, wo der Nutzer den Monat angeben kann, der kopiert werden soll und dann anschließend die Zeilen dieses Monats in die neue Datei kopiert werden?
Vielen Dank und schöne Grüße,
tom

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Monatsabfrage + kopieren von diesen Daten
02.12.2005 08:49:55
diesen
Moin Tom,
Daten / Filter / Autofilter
benutzerdefiniert nach den gewünschten Datumsgrenzen filtern
wäre meine Wahl der Waffen.
Das Ansprechen der richtigen Zellen funzt so
dim frage as string, i as long
frage = InputBox("Bitte Monatsangabe als zweistellige Ziffer eingeben", "Anfrage")
If frage = "" Then Exit Sub
for i = 2 to cells(rows.count, 2).end(xlup).row
If Format(Range("b" & i), "MM") = frage Then
rows(i).copy irgendwohin
oder
range("A" & i & ":D" & i & ", F" & i & ":F" & i).copy irgendwohin
oder
range(Cells(i, 2), cells(i, 22)).copy irgendwohin
End If
next i
Gruss Harald
Anzeige
AW: Monatsabfrage + kopieren von diesen Daten
02.12.2005 11:14:01
diesen
Hallo Harald,
vielen Dank für Deinen Tip.
Leider kriege ich immer eine Fehlermeldung: Laufzeitfehler '1004'. Die copy Methode des range-Objektes konnte nicht ausgeführt werden.
Ich vermute, es liegt daran, daß ich das Ziel nicht richtig eingegeben habe, kann das sein?
Ich habe "copy irgendwohin" ersetzt durch
Rows(i).Copy Tabelle3
Rows(i).Copy:=("Tabelle3")
Rows(i).Copy Destination:=("Tabelle3")
aber es gibt immer den gleichen Fehler.
Eigentlich will ich aber sowieso, daß die Daten in eine neue Datei kommen, nicht in die gleiche, ich weiß bloß nicht, wie ich das angeben muß.
Besten Dank und schöne Grüße,
Thomas
Anzeige
AW: Monatsabfrage + kopieren von diesen Daten
02.12.2005 11:15:44
diesen
Hallo Harald,
vielen Dank für Deinen Tip.
Leider kriege ich immer eine Fehlermeldung: Laufzeitfehler '1004'. Die copy Methode des range-Objektes konnte nicht ausgeführt werden.
Ich vermute, es liegt daran, daß ich das Ziel nicht richtig eingegeben habe, kann das sein?
Ich habe "copy irgendwohin" ersetzt durch
Rows(i).Copy Tabelle3
Rows(i).Copy:=("Tabelle3")
Rows(i).Copy Destination:=("Tabelle3")
aber es gibt immer den gleichen Fehler.
Eigentlich will ich aber sowieso, daß die Daten in eine neue Datei kommen, nicht in die gleiche, ich weiß bloß nicht, wie ich das angeben muß.
Besten Dank und schöne Grüße,
Thomas
Anzeige
AW: Monatsabfrage + kopieren von diesen Daten
02.12.2005 11:51:57
diesen
Hi,
wgeen Zeitmangel nur mal kurz aus der Handgelenk
frage = InputBox("Bitte Monatsangabe als zweistellige Ziffer eingeben", "Anfrage")
If frage = "" Then Exit Sub
Lrow = cells(rows.count, 2).end(xlup).row
workbooks.add
x = 1
for i = 2 to Lrow
If Format(Range("b" & i), "MM") = frage Then
windows("Kassendatei.xls").activate
rows(i).Copy
Windows("Mappe1").Activate
range("A" & x).insert shift:=xldown
end if
x = x +1
next i
Hoffe es sind keine Rechtschreibfehler drin ;-))
Gruss Harald
AW: Monatsabfrage + kopieren von diesen Daten
02.12.2005 12:22:02
diesen
Hallo Harald,
merci - alles scheint zu gehen, leider wird in die neue Datei nichts eingefügt, sie bleibt leer.
Wenn ich den Code Schritt für Schritt laufen lasse, dann wird ein Teil des Codes immer übersprungen:
Windows("Kassendatei.xls").Activate
Rows(i).Copy
Windows("Mappe1").Activate
Range("A" & x).Insert shift:=xlDown
Kann es daran liegen? (Die Datei, aus der die Daten kommen, habe ich in Kassendatei.xls umbenannt).
Danke und beste Grüße,
Thomas
Anzeige
AW: Monatsabfrage + kopieren von diesen Daten
02.12.2005 12:51:38
diesen
Irgendwie nicht mein Tag heute ;-(
Er überspringt den Teil, weil die If Bedingung nicht erfüllt ist. Nach workbooks.add ist die neue Mappe aktiv und dort steht nirgendwo ein Datum. Also vor der If Abfrage die richtige Datei aktivieren.
x = 1
for i = 2 to Lrow
windows("Kassendatei.xls").activate
If Format(Range("b" & i), "MM") = frage Then
Noch ein Hinweis. Das mit Mappe1 ist fehleranfällig (wenn z.B eine Mappe1 schon geöffnet ist, wird aus dem neuen Workbook schonmal Mappe2. daher die neue Mappe direkt nach workbook.add schonmal "taufen" (Ordnerstruktur mußte natürlich anpassen)
ActiveWorkbook.SaveAs Filename:= _
"C:\Eigene Dateien\Ordner\Sammeldaten aus_" & frage & "_05.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
und im Kopiermakro statt
Windows("Mappe1").Activate
folgendes schreiben
Windows("Sammeldaten aus_" & frage & "_05.xls").Activate
Gruss Harald
Anzeige
AW: Einfügestelle & fehlender Bezug
02.12.2005 13:28:02
tom
Hallo Harald,
das ist super. Danke auch für den Tip mit Anleitung für das automatische Speichern.
Es gibt noch ein kleines Problem: Die Zeilen werden in der neuen Datei an der gleichen Stelle eingefügt, wo sie auch in der Originaldatei waren, also, bspw. Oktober in Zeile 159. Sie sollten aber immer in Zeile 2 beginnen (In Zeile 1 muß noch die Zeile 1 der Originaltabelle rein).
Ich habe jetzt auch noch ein anderes Problem bemerkt, das mit der Struktur der Originaltabelle zu tun hat. Es gibt eine Zelle in jeder Zeile, die sich auf den Vortag bezieht (in Spalte K). Wenn man jetzt kopiert, dann fehlt dieser Bezug für die erste Zeile. Es müßte also in der ersten kopierten Zeile in der Spalte K der Originalwert als feste Zahl eingetragen werden. Geht das irgendwie? Die Zielzelle wäre dabei gar nicht das Problem, denn es ist ja immer k2. Man könnte die Zahl sicher auch am Ende der ganzen Prozedur noch mal drüberkopieren lassen. Aber wie finde ich die richtige Stelle im Originalblatt. Die Zelle der Spalte K in der Zeile, die als erste Zeile bei der Abfrage rauskam?
Vielen herzlichen Dank und schöne Grüße,
Thomas
Anzeige
AW: Einfügestelle & fehlender Bezug
02.12.2005 14:08:09
Harald
Hi,
irgendwie steh ich heute neben mir.
versuch mal das x = 2 vor den Codeteil
und am Ende das x = x + 1 vor das End If zu stellen
Gruss Harald
AW: Einfügestelle & fehlender Bezug
02.12.2005 14:21:28
Harald
wegen dem zweiten Problem sollte man das kopieren gleich ganz lassen
die If- Abfrage lassen wie sie ist und den Then Block ändern
neue Mappe aktivieren
Sheets("Tabelle1").range("a1") = "Überschrift"
der unveränderte If - Teil und then
LrowB = thisworkbook.sheets("Tabelle1").cells(rows.count, 1).end(xlup).row + 1
thisworkbook.sheets("Tabelle1").range(cells(LrowB, 1), cells(LrowB, 22)= _
workbooks("Originaldatei").sheets("2005").range(cells(i, 1), cells(i, 22).value
Hoffe Du blickst das. x = 1 sowie x = x + 1 müssen natürlich gelöscht werden.
Mit LrowB erhälst du die erste freie Zeile der neuen Mappe und setzt die Spalten 1 bis 22 dieser Zeile gleich den WERTEN des gleich großen Bereichs aus der Fundzeile (i).
Gruss Harald
Anzeige
AW: Einfügestelle & fehlender Bezug
02.12.2005 14:21:38
tom
Yup - das war die Lösung.
Hast Du noch eine Idee, wie man das Problem mit dem Bezug zu der Vormonatszeile lösen könnte? (ich brauch's auch nicht in den nächsten Minuten...)
Allergrößten Dank,
Thomas
PS: So sieht das ganze jetzt aus:
frage = InputBox("Bitte Monatsangabe als zweistellige Ziffer eingeben", "Anfrage")
If frage = "" Then Exit Sub
Lrow = Cells(Rows.Count, 2).End(xlUp).Row
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"C:\plattsalat\Kasse\Monatsberichte Kasse ohne LS\Kassendaten Monat_" & frage & "_05.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
x = 2
For i = 2 To Lrow
Windows("Kassendatei.xls").Activate
If Format(Range("b" & i), "MM") = frage Then
Rows(i).Copy
Windows("Kassendaten Monat_" & frage & "_05.xls").Activate
Range("A" & x).Insert shift:=xlDown
x = x + 1
End If
Next i
Windows("Kassendaten Monat_" & frage & "_05.xls").Activate
ActiveWorkbook.Save
Anzeige
AW: Einfügestelle & fehlender Bezug
02.12.2005 14:45:48
Harald
Hi,
so...Da ich jetzt Wochenende hab ;-))) nur noch kurz ein Ansatz zum Verständnis und selbstbasteln.

Sub oderdochmitcopy()
Lrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 2 To Lrow
Sheets(1).Activate
If Format(Range("b" & i), "MM") = 12 Then
LrowB = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1
Range(Cells(i, 1), Cells(i, 5)).Copy
Sheets(2).Cells(LrowB, 1).PasteSpecial Paste:=xlPasteValues
End If
Next i
End Sub

Der kopiert nur die Werte (ob das mit rows(i) funzt, weiß ich nicht). Besser ist es den Bereich mit Range(cells...etc genau abzugrenzen.
Gruss Harald
Anzeige
AW: Einfügestelle & fehlender Bezug
02.12.2005 15:11:25
tom
Hallo Harald,
wenn ich Dich recht verstehe, wird jetzt alles als Werte eingefügt. Ich brauche in der neuen Datei auch die Formeln, nur diese eine Zahl, muß als Wert eingefügt/oder überschrieben werden.
Ich kann mir denken, daß man alles so lassen kann, wie es war, nur am Ende nochmal in die erste Suchzeile geht und dort aus der Spalte K diese eine Zelle nochmal kopiert und als Wert in das neue Blatt über die Formel einfügt.
Wäre das keine Lösung? Ich weiß eben nur nicht, wie ich es schreiben muß, damit ich diese Zelle auffinde.
Merci und gutes Wochenende,
Thomas
AW: Einfügestelle & fehlender Bezug
02.12.2005 15:42:15
Harald
Das wird dann ein Mehrzeiler ;-)) D.h. Bereich für Bereich kopieren.
Für die Formel
cells(LrowB, Spaltennummer).PasteSpecial Paste:=xlPasteFormulas
oder wenn du es mit dem = probierst. statt .value einfach .formula
Wie gesagt, Bereich für Bereich der betreffenden Zeile.
Schönes WE
Harald
AW: Einfügestelle & fehlender Bezug
02.12.2005 17:35:30
tom
Oje, da steige ich jetzt aus.
Mir ist nicht klar, was davon wo und wie rein müßte. So ist die Datei aber immerhin schon nicht schlecht, man muß eben diesen einen Wert von Hand nachtragen, dann geht's ja auch.
Merci vielmals und Grüße,
Thomas
geschlossen ?
05.12.2005 11:04:51
Harald
eigentlich könntest Du dir anhand einer kleinen Beispielmappe die Wirkungsweisen der verschiedenen Codezeilen mal austesten.
Alles was Du brauchst, ist in den bisherigen Antworten enthalten
Gruss Harald
AW: geschlossen ?
05.12.2005 13:14:35
tom
Hallo Harald,
in den Dingen, die ich/wir bisher gemacht haben, waren schon ein paar Sachen, die ich einfach gemacht habe, aber nicht komplett verstehe, weil mir ein paar Grundlagen fehlen, um unterscheiden zu können und um zu wissen, was welcher Teil des Codes wo bewirkt und welchen Teil man z.B. wie nehmen müßte, um etwas ähnliches zu erreichen. Ich habe es dann einfach ausprobiert und getestet und so zusammengesetzt daß/bis es funktioniert hat.
Das nur als Erklärung dafür, warum ich mit dem letzten Tip nicht weitergekommen bin. Trotzdem aber vielen Dank für das vorige, es hat mir sehr geholfen!
Beste Grüße,
Thomas
Danke für die Rückmeldung...das wird schon
05.12.2005 13:38:08
Harald
;-))
Gruss Harald

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige