Wie wäre es korrekt?
09.10.2019 13:31:33
Flip
Ich trage immer wieder Daten von einer Tabelle in ein anderes Tabellenblatt mittels Makro ein. Das ganze habe ich mir irgendwann mit dem Makrorecorder und ein paar Codeschnipseln zusammengebastelt. Ich verwende diese Vorgehensweise mittlerweile in mehreren Dateien. Mein Frage ist jetzt wie man es richtig machen würde denn ich weiß das es so sicher nicht stimmen kann obwohl das Ergebnis eigentlich immer passt.
Sub Benotung_drucken()
' Notenschlüssel anhand der Datenbank ausdrucken
' Es müssen nur die Punkte eingegebne werden und die Note wird anhand eines defeniertem _
Noteschlüssel berechnet.
' Mit diesem Makro kann der Notenschlüssel direkt anhand der Zeile wo man steht ausgedruckt _
werden.
' einfach in eine X beliebige Zelle der gewünschten Zeile anklicken und das Makro ausführen
' Datenbank ist als Tabelle formatiert und als "Datenbank" benannt
' in [..] gesetze Zahle ist der Spaltenindex der Tabelle
Application.ScreenUpdating = False
Sheets("Datenbank").Select
Application.Intersect(Selection.EntireRow, Columns([46])).Copy 'kopiert die maximal mö _
_
_
gliche Punktezahl
Sheets("Druckausgabe Note").Select
ActiveSheet.Range("E5").PasteSpecial xlValues
Sheets("Datenbank").Select
Application.Intersect(Selection.EntireRow, Columns([44])).Copy 'kopiert die erreichte _
_
_
Punktezahl
Sheets("Druckausgabe Note").Select
ActiveSheet.Range("E6").PasteSpecial xlValues
Sheets("Datenbank").Select
Application.Intersect(Selection.EntireRow, Columns([48])).Copy 'kopiert die berechnete _
_
_
Note
Sheets("Druckausgabe Note").Select
ActiveSheet.Range("H5").PasteSpecial xlValues
Sheets("Datenbank").Select
Application.Intersect(Selection.EntireRow, Columns([47])).Copy 'kopiert die _
berechneten %
Sheets("Druckausgabe Note").Select
ActiveSheet.Range("H6").PasteSpecial xlValues
Sheets("Datenbank").Select
Application.Intersect(Selection.EntireRow, Columns([51])).Copy 'kopiert die maximal mö _
_
_
gliche Punktezahl ohne Allgemeinbildung
Sheets("Druckausgabe Note").Select
ActiveSheet.Range("E8").PasteSpecial xlValues
Sheets("Datenbank").Select
Application.Intersect(Selection.EntireRow, Columns([49])).Copy 'kopiert die erreichte _
_
_
Punktezahl ohne Allgemeinbildung
Sheets("Druckausgabe Note").Select
ActiveSheet.Range("E9").PasteSpecial xlValues
Sheets("Datenbank").Select
Application.Intersect(Selection.EntireRow, Columns([53])).Copy 'kopiert die errechnete _
_
_
Note ohne Allgemeinbildung
Sheets("Druckausgabe Note").Select
ActiveSheet.Range("H8").PasteSpecial xlValues
Sheets("Datenbank").Select
Application.Intersect(Selection.EntireRow, Columns([52])).Copy 'kopiert die _
berechneten % ohne Allgemeinbildung
Sheets("Druckausgabe Note").Select
ActiveSheet.Range("H9").PasteSpecial xlValues
Sheets("Druckausgabe Note").PrintOut
Sheets("Datenbank").Select
Application.ScreenUpdating = True
End Sub
Problem: Hier kann ich immer nur eine Zeile übertragen. Es gibt aber Dateien wo ich gerne mehrere Zeilen mittels X markieren würde und diese dann in eine anderes Blatt immer untereinander in die jeweils nächste freie Zeile eintragen möchte.
LG Philipp