Kopieren in unterschiedliche Tabellenblätte
25.01.2019 10:51:54
Micro
Ich habe für mich und meine Kollegen eine Reisekostenabrechnung erstellt.
Bitte seht mir die Leihenhafte Erstellung der VBA Codes nach, ich habe mir alles nur zusammen gesucht und so gut es geht umgesetzt.
Grundfunktion:
- Einträge werden im Tabellenblatt "Fahrtkostenmeldung" eingegeben.
- Durch den Button "KW abschließen und zurücksetzen" soll der Inhalt des angegebenen Bereiches sowie die Formatierung aus dem Datenblatt "Fahrtkostenmeldung in das Datenblatt "Jahresübersicht" immer an die 1. Freie Zeile ab der Zeile kopiert werden.
- Er soll nach dem Kopiervorgang wieder zurück in das Blatt "Fahrtkostenmeldung" wechseln.
Das funktioniert auch soweit reibungslos.
Allerdings bleibt der komplette kopierte Bereich im Tabellenblatt "Jahresübersicht" nach dem Kopiervorgang weiter markiert. Das soll nicht sein.
Könnt ihr mir hier helfen? Funktionieren will es bislang nicht.
Hier der Code:
Sub KW_abschliessen()
Dim Zeile As Long, Spalte As Long
Dim LastRow As Integer
Dim wksWo As Worksheet
Dim wksJahr As Worksheet
'Message Box generieren
If MsgBox("KW abschliessen & zuruecksetzen?", vbOKCancel) = vbCancel Then
Exit Sub
End If
Set wksMeldung = Sheets("Fahrtkostenmeldung")
Set wksJahr = Sheets("Jahresuebersicht")
Application.ScreenUpdating = False
With wksJahr
'erste freie Zeile in Ausgabe-Blatt in Uebersicht
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
'Bereich 1 kopieren
wksMeldung.Range("A14:AC65").Copy
'einfuegen in
Spalte = .Range("A14").Column
.Cells(Zeile, Spalte).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(Zeile, Spalte).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
With wksJahr
Range("D11").Select
End With
With wksJahr
ActiveWindow.ScrollColumn = 65
Range("AF20:BA65").Select
Selection.Copy
ActiveWindow.ScrollColumn = 1
Range("A20").Select
ActiveSheet.Paste
Range("J17").Select
'Kopiermodus beenden
Application.CutCopyMode = False
Application.ScreenUpdating = True
End With
End
Sub
Anzeige