Makros aufzeichnen vs. Makro selber schreiben

Question

Hallo zusammen,

ich hab doch nochmal eine Frage.

Ich habe zwei Tabellenblätter:

1)

Zelle A1 = Name
Zelle A2 = Vorname
Zelle A3 = Anschrift

usw. wie viele genau weiß ich aber noch nicht. Ungefähr soll das erste Tabellenblatt 20 Einträge haben

Wenn jetzt die 20 Einträge gemacht sind, möchte ich die per Makro in ein zweites Tabellenblatt einfügen. Und zwar so das dich 20 Einträge dann in die nächst mögliche leere Zeile nebeneinander, also über 20 Spalten, eingefügt werden.

Wenn ich ein Makro per Hand aufzeichne, wird das leider immer in die selbe Zeile eingetragen.

Nun kann man ja ein MAkro das aufgezeichnet wurde, auch verändern. Nur hier scheitert es an meinen Kompetenzen und ganz von Hand ein Makro schreiben kann ich auch nicht.

Eventuell weiß jemand, wie man den Eintrag in dem aufgezeichneten Makro ändern muss?

Wie gesagt ich weiß auch noch nicht genau wie viel Felder ich im Endeffekt brauche.

Vielen Dank und Gruß

Alex

Answer 1

Hallo Alex,

Eventuell weiß jemand, wie man den Eintrag in dem aufgezeichneten Makro ändern muss?

....ich bin sicher, dass das jemand weiß.

Natürlich wäre es von Vorteil. wenn Du uns Dein aufgezeichnetes Makro mal zeigst.
Noch besser wäre eine Beispielmappe dazu.

Gruß
Rainer

Answer 2

Ich wollte eine datei hochladen, leider immer Fehler, eventuell wegen dem Makro?

Hier mal der Text des aufgezeichneten Makros:

Vielleicht kann man bei Range einfach (A & istleer) oder so eintragen?


Sub uerbertragen()
'
' uerbertragen Makro
'
' Tastenkombination: Strg+Q
'
Selection.Copy
Sheets("Datensammlung").Select
Range("A3").Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("B3").Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("C3").Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("D3").Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("E3").Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("F3").Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("G3").Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("H3").Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("I3").Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("J3").Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("K3").Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("L3").Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("M3").Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B6").Select
End Sub


Vielen Dank

Gruß Alex

Answer 3

Hallo Alex,

versuche den Upload mal hiermit und poste den Downloadlink.
Habe keine Lust Deinen Spaghetticode zu analysieren.

Gruß
Rainer

Answer 4

Kann ich natürlich verstehen. Danke, bei dem Link hat es funktioniert.

Hier also der Downloadlink:

http://www.file-upload.net/download-7990716/datensammlung2.xls.html


Gruß Alex

Answer 5

Hallo,

eine Lösung bei der du die laufende Nummer vorgibst

Sub uerbertragen()
'
' uerbertragen Makro
'
' Tastenkombination: Strg+Q
'
Zeile = Range("B6").Value + 1
Selection.Copy

Sheets("Datensammlung").Select
Range("A" & Zeile).Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("B" & Zeile).Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("C" & Zeile).Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("D" & Zeile).Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("E" & Zeile).Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("F" & Zeile).Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("G" & Zeile).Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B1" & Zeile).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("H" & Zeile).Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("I" & Zeile).Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("J" & Zeile).Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("K" & Zeile).Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("L" & Zeile).Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Datensammlung").Select
Range("M" & Zeile).Select
ActiveSheet.Paste
Sheets("Dateneingabe").Select
Range("B6").Select
End Sub

Gruß

Helmut

Answer 6

Hallo,

eine kleine Ergänzung in den letzten Zeilen

Range("B6").Select
End Sub

durch

Range("B6").Value = Zeile
Range("B7:B18").Clear
End Sub

ersetzen, damit wird automatisch die nächste Nummer eingetragen.

Gruß

Helmut

Answer 7

Hi Alex,

versuche es mal so:

Sub uerbertragen()
'
' uerbertragen Makro
'
' Tastenkombination: Strg+Q
Dim lngErste As Long
With Sheets("Datensammlung")
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Sheets("Dateneingabe").Range("B6").Copy .Cells(lngErste, 1)
Sheets("Dateneingabe").Range("B7").Copy .Cells(lngErste, 2)
Sheets("Dateneingabe").Range("B8").Copy .Cells(lngErste, 3)
Sheets("Dateneingabe").Range("B9").Copy .Cells(lngErste, 4)
Sheets("Dateneingabe").Range("B10").Copy .Cells(lngErste, 5)
Sheets("Dateneingabe").Range("B11").Copy .Cells(lngErste, 6)
Sheets("Dateneingabe").Range("B12").Copy .Cells(lngErste, 7)
Sheets("Dateneingabe").Range("B13").Copy .Cells(lngErste, 8)
Sheets("Dateneingabe").Range("B14").Copy .Cells(lngErste, 9)
Sheets("Dateneingabe").Range("B15").Copy .Cells(lngErste, 10)
Sheets("Dateneingabe").Range("B16").Copy .Cells(lngErste, 11)
Sheets("Dateneingabe").Range("B17").Copy .Cells(lngErste, 12)
Sheets("Dateneingabe").Range("B18").Copy .Cells(lngErste, 13)
End With
Sheets("Dateneingabe").Range("B7:B18").ClearContents
Sheets("Dateneingabe").Range("B6") = Sheets("Dateneingabe").Range("B6") + 1
End Sub

Der mit dem Makrorekorder aufgezeichnete Code ist natürlich sehr hilfreich, aber er zeichnet eben jeden Arbeitsschritt auf, von denen eine ganze Reihe überhaupt nicht erfoderlich sind - so kann man in 99% aller Fälle auf Select und Activate verzichten.

Bis später,
Karin

Answer 8

Hi Alex,

übrigens: da ein fortlaufender Spaltenbereich in einen fortlaufenden Zeilenbereich kopiert werden soll, geht es noch einfacher - mit Kopieren -> Inhalte einfügen -> Transponieren

With Sheets("Datensammlung")
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Sheets("Dateneingabe").Range("B6:B18").Copy
.Cells(lngErste, 1).PasteSpecial Paste:=xlAll, Transpose:=True
Application.CutCopyMode = False
End With

Bis später,
Karin

Answer 9

Hallo Karin und Helmut

Ich möchte mich bei euch beiden recht herzlich bedanken. Die Makros funktionieren bestens und haben mein Problem gelöst. Ich muss mir unbedingt mal ein Buch holen. Die Änderungen von Helmut sind noch gut nachvollziehbar, was dadurch nun passiert, bei dem von Karin muss ich größtenteils passen.

Das einzige was nicht funktioniert ist die Tastenkombination, aber evtl liegt das an Excel. Das werde ich nochmal erforschen.

Vielen Dank nochmal

Gruß Alex

Answer 10

Hallo nochmal,

Also für alle bei denen die Tastenkombination angeblich nicht mehr funktioniert, so wie bei mir eben.


Makros - "gewünschtes anwählen" - Optionen - Aktuelle Einstellung der Tastenkombination wird angezeigt, die entweder ausführen oder gewünscht anpassen.

Gruß Alex