AW: Geisterdaten?
19.01.2006 10:44:49
ge-ka
Hallo Leutz!
erstmal danke für das interesse.
hier meine Sub. Mir ist klar, daß hier noch erheblich gekürzt werden kann, aber der übersichtlichkeit halber(und weil ich nicht so ein grandioser vba'ler bin)habe ich erstmal jeden schritt einzeln zurechtgeschnitzt.
danke für jeden hinweis.
ge-ka
Sub Spesen_Schaltfläche4_BeiKlick()
Application.ScreenUpdating = False
Dim wksDaten As Worksheet
Dim wksZiel As Worksheet
'Tabellennamen anpassen
Set wksDaten = Worksheets("Spesen") 'Tabelle14
Set wksZiel = Worksheets("Spesendat") 'Tabelle5
lngZeile = wksZiel.Range("C65536").End(xlUp).Row + 1
'Block" anpassen
With wksDaten
.Range("Q5:AI5").Copy
wksZiel.Range("C" & lngZeile).PasteSpecial xlPasteValues
End With
With wksZiel
.Range("C11 : D130").Copy
wksZiel.Range("AA11 : AB130").PasteSpecial xlPasteValues
.Range("F11 : G130").Copy
wksZiel.Range("AC11 : AD130").PasteSpecial xlPasteValues
.Range("C11 : D130").Copy
wksZiel.Range("AG11 : AH130").PasteSpecial xlPasteValues
.Range("I11 : K130").Copy
wksZiel.Range("AI11 : AK130").PasteSpecial xlPasteValues
.Range("C11 : D130").Copy
wksZiel.Range("AN11 : AO130").PasteSpecial xlPasteValues
.Range("M11 : N130").Copy
wksZiel.Range("AP11 : AQ130").PasteSpecial xlPasteValues
.Range("C11 : D130").Copy
wksZiel.Range("AT11 : AU130").PasteSpecial xlPasteValues
.Range("P11 : R130").Copy
wksZiel.Range("AV11 : AX130").PasteSpecial xlPasteValues
End With
Worksheets("Spesendat").Activate
Range("AA11 : AF130").Select
Selection.Sort Key1:=Range("AE11 : AE130"), Order1:=xlAscending, Key2:=Range("AF11 : AF130"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
True, Orientation:=xlTopToBottom
Range("AG11 : AL130").Select
Selection.Sort Key1:=Range("AL11 : AL130"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Range("AN11 : AR130").Select
Selection.Sort Key1:=Range("AR11 : AR130"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Range("AT11 : AZ130").Select
Selection.Sort Key1:=Range("AZ11 : AZ130"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Worksheets("Spesen").Activate
Range("C6, C8, C12").Select
Selection.ClearContents
Range("C6").Activate
MsgBox "Die Daten wurden übergeben"
Application.ScreenUpdating = True
End Sub