01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65 |
|
Option Explicit
Sub Test()
' Deklaration der Variablen sBer sind Arrays vom Typ String
Dim sBer1() As String, sBer2() As String
Dim i As Integer, iZlQ As Long, iZlZ As Long
' Achtung: Zur Vorbereitung in jeder der Zeilen ein Feld einen Namen geben
' Aus den benannten Zellen wird jeweils die Zeile entnommen
' Bei Einfügen/Löschen von Zeilen wandern die Namen mit
iZlZ = Range("Zielzeile").Row
iZlQ = Range("Quellzeile").Row
' Quelldaten sortiert
Worksheets("Offen").Select
Range("Tabelle1").Sort _
Key1:=Range("A" & iZlQ), _
Order1:=xlAscending, _
Header:=xlYes
If Range("A" & iZlQ) = "Ausgezahlt" Then
' Die gewünschten Felder für Ziel- und Quelle werden in ein Array aufgesplittet
' und die ermittelten Zeilennummern eingesetzt
sBer1 = Split(Replace("A1:B1 D1:F1 H1 J1", "1", iZlZ))
sBer2 = Split(Replace("E1:F1 G1:I1 C1 K1", "1", iZlQ))
' Die Werte aus den Quellzellen werden direkt in die Zielzellen transferiert
For i = 0 To UBound(sBer1) ' von 0 bis Anzahl Array-Member
Worksheets("Ausgezahlt").Range(sBer1(i)).Value = _
Worksheets("Offen").Range(sBer2(i)).Value
Next i
Worksheets("Ausgezahlt").Select
Range("Tabelle8").Sort _
Key1:=Range("I" & iZlZ), _
Order1:=xlAscending, _
Header:=xlYes
Range("A1").Select
Worksheets("Offen").Rows(iZlQ & ":" & iZlQ).Delete
Worksheets("Offen").Select
Range("Tabelle1").Sort _
Key1:=Range("B" & iZlQ), _
Order1:=xlAscending, _
Header:=xlYes
Range("A1").Select
Worksheets("Ausgezahlt").Select
MsgBox "Die Daten wurden erfolgreich verschoben. Bitte noch Abteilung und Auszahlung angeben."
Else
Range("Tabelle1").Sort _
Key1:=Range("B8"), _
Order1:=xlAscending, _
Header:=xlYes
MsgBox "Bitte vorher den ausgezahlten Kunden auf Status ausgezahlt stellen."
End If
End Sub
|