Excel 2003 Makro erstellen

Computer: Software & Programmierung Visual Basic
#1

Hallo Herr Hanzl,
vielleicht können Sie mir helfen?

Ich habe 2 Tabellenblätter zusammengefasst in einer Excel Mappe.
Tab1 besteht aus ca 150 Zeilen und ca 12 Spalten.
Jedes Feld enthält entweder Text od. Zahlen.
Ich möchte aus Tab1 den Inhalt verschiedener Zellen in Tab2 in ganz bestimmte Zellen einfügen. Angefangen mit Zeile 1 und nachdem die ausgewählten Zellen von Zeile 1 alle in die dafür vorgesehenen Zellen in Tab2 übertragen wurden - Tab2 als einzelnes Blatt ausdrucken. Dann weiter mit Zeile 2 den
Vorgang wiederholen und am Ende als Einzelblatt wieder ausdrucken. Dieses auf alle Zeilen ( 150) anwenden, wobei die Zeilenzahl auch differieren kann (zwischen 110 und 150).
Derzeit habe ich ein Makro angefertigt das diese Arbeit auch erledigt (jetzt ca 15 Mal da der nachfolgende Befehlssatz 15x kopiert wurde und die Zellbezüge manuell angepasst wurden)- aber für ca 15oZeilen sollte doch eine Automatisierung möglich sein. Hier nun ein Befehlssatz wie ich ihn derzeit benutze und nur mit Copy und Veränderung der Zellbezüge auch zum Laufen bringe.

x1
Range(„A11:C11“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-10]C“
Range(„D11:E11“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-10]C[-2]“
Range(„F11:I11“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-10]C[-3]“
Range(„J11“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-10]C[-6]“
Range(„G12:J13“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-11]C“
Range(„J15“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-14]C[-2]“
Range(„C14:E14“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-13]C[9]“
Range(„G14:J14“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-13]C[6]“
Range(„G15:I15“).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1
’ x2
Range(„A11:C11“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-9]C“
Range(„D11:E11“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-9]C[-2]“
Range(„F11:I11“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-9]C[-3]“
Range(„J11“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-9]C[-6]“
Range(„G12:J13“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-10]C“
Range(„J15“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-13]C[-2]“
Range(„C14:E14“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-12]C[9]“
Range(„G14:J14“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-12]C[6]“
Range(„G15:I15“).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1
’ x3
Range(„A11:C11“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-8]C“
Range(„D11:E11“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-8]C[-2]“
Range(„F11:I11“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-8]C[-3]“
Range(„J11“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-8]C[-6]“
Range(„G12:J13“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-9]C“
Range(„J15“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-12]C[-2]“
Range(„C14:E14“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-11]C[9]“
Range(„G14:J14“).Select
ActiveCell.FormulaR1C1 = „=Übertrag!R[-11]C[6]“
Range(„G15:I15“).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1

Ich hoffe mir kann jemand helfen ?! Auf jeden Fall schon mal DANKE!

#2

Das ist eine von vielen Lösungen:
die „Ziel“-Zeilen und „Ziel“-Spalten gehören
noch angepasst:

Sub neu()
On Error GoTo BEENDEN
'erste Datenzeile aus Quelle: 7
'max Anzahl Zeilen: 200
'Sheets(„Ziel“).cells(5=Zeile,6=Spalte)
For QuelleVon = 7 To 200
If Sheets(„Ziel“).Cells(QuelleVon, 1).Value = „“ Then Exit For
Sheets(„Ziel“).Cells(5, 6).Value = Sheets(„Quelle“).Cells(QuelleVon, 10).Value
Sheets(„Ziel“).Cells(8, 10).Value = Sheets(„Quelle“).Cells(QuelleVon, 9).Value
'nächster Befehlssatz
'nächster Befehlssatz
'nächster Befehlssatz
'ActiveWindow.SelectedSheets.PrintOut Copies:=1
Next QuelleVon
BEENDEN:
End Sub

Viel Spaß

#3

Hallo Erwin
Vielen Dank fuer Deine Antwort . Leider kann ich Deinen Vorschlag erst über Weihnachten ausprobieren. Vom Aussehen aber scheint es das zu sein was mir helfen kann. Also erstmal Vielen Dank und schöne Feiertage.
Gruss Franz