Hallo mister-macro,
deine Spezifikation ist wieder unklar. Das sieht man ja auch daran, dass du bisher keine Antwort erhalten hast. Ich habe mich an deine, leider auch nicht ganz präzise Beschreibung des geünschten Makros gehalten.
(If "sheet Journal". spalte B enthält "kasse" = then
kopiere diese zelle (Zelle?) mit dem ziel (Ziel?) "sheet Kasse" in ertse (erste?) freie zelle (Zelle?) spalte (Spalte?) B
kopiere ebenso den Betrag aus "sheet Journal". Zeile (Spalte?) D mit ziel (Ziel?) "sheet kasse" in selbe (dieselbe?) zeile (Zeile, ?) aber spalte (Spalte?) D)
Es macht viel mehr Spaß, für jemanden zu arbeiten, wenn man merkt, dass er sich bei seiner Formulierung Mühe gegeben hat, und man nicht denken muss, dass der Schreiber vielleicht der Auffassung ist, dass die Trottel vom Forum sich ja gefälligst den Kopf darüber zerbrechen können, was wohl gemeint sein könnte.
Ich bin gespannt, ob mein Makro deinen vorstellungen wirklich entspricht.
Sub Buchung()
Sheets("Journal").Activate
ziel = InputBox("Kasse, Ertrag, Aufwand")
For Each s In Worksheets 'Prüft, ob Ziel-Sheet existiert und legt es ggf. an
If s.Name = ziel Then a = True: Exit For
Next
If a kleinergrößer True Then
Set NewSheet = Worksheets.Add
ActiveSheet.Name = ziel
Sheets("Journal").Activate
End If
'sucht nach dem Eintrag aus der Inputbox zum ersten Mal
Set rng = Sheets("Journal").Columns(2).Find(What:=ziel, LookIn:=xlValues, LookAt:=xlPart)
If Not rng Is Nothing Then
erstes = rng.Row 'erste Fundstelle
lz = Sheets(ziel).Cells(Rows.Count, 2).End(xlUp).Row + 1 '1. freie Zeile in sheets(Ziel)
If lz = 2 And Sheets(ziel).Cells(1, 2) = "" Then lz = lz - 1 'falls noch ganz leer, in Zeile 1 beginnen
Sheets(ziel).Cells(lz, 2) = Cells(rng.Row, 2) 'Spalte B Kopieren
Sheets(ziel).Cells(lz, 4) = Cells(rng.Row, 4) 'Spalte D Kopieren
End If
'sucht nach weiteren Eintrag aus der Inputbox
Do
Set rng = Sheets("Journal").Columns("B").FindNext(After:=rng)
If rng.Row kleiner= erstes Then Exit Sub 'hört auf, wenn erste Fundstelle erneut gefunden wird
lz = lz + 1 'letzte Zeile in sheets(Ziel)
Sheets(ziel).Cells(lz, 2) = Cells(rng.Row, 2) 'Spalte B Kopieren
Sheets(ziel).Cells(lz, 4) = Cells(rng.Row, 4) 'Spalte D Kopieren
Loop While rng.Row größer erstes
End Sub
Gruß
Holger
mister-macro schrieb am 06.07.2009 10:45:25:
Hallo,
Ich schreibe gerade an einer kleinen buchhaltungsoftware in excel, Das beinhaltet aufstellungen wie Bilanz und Erfolgrechnung.
Nun habe ich in meiner mappe mehrere sheets, das erste heisst "journal" und dort werden alle Buchungen eingetragen, mit den konten und dem Betrag + Buchungssatz. (zb: Kasse / Ertrag ; 100.- ; Barverkauf t-shirt)
Des weiteren habe ich div. konten-sheets wie "kasse", "ertrag" oder "aufwand". diese konten (in T-form) sollen nun im soll und haben (lnks u. rechts) mit den daten aus dem Journal gefütterte werden. Damit der Ablauf auotmatisiert wird.
Könnte mir jemand helfen, ein macro zu schreiben, welches mir eine spalte nach kriterien durchsuchen kann, und bei einem treffer diese "konten-Zelle" so wie den dazuheörenden Betrag in ein anderes Sheet kopieren kann?
Ich würde die Datei auch gerne zur verfühgung stellen, eignet sich gut für kleien firmen oder vereine und clubs zur Buchführung.
Der code müsste etwas so lauten:
If "sheet Journal". spalte B enthält "kasse" = then
kopiere diese zelle mit dem ziel "sheet Kasse" in ertse freie zelle spalte B
kopiere ebenso den Betrag aus "sheet Journal". Zeile D mit ziel "sheet kasse" in selbe zeile aber spalte D
wenn das nciht klar ist, kann ich gerne ein detailierteres beispiel geben!
vielen dank im vorraus!
A |