Ich versuche in einem Arbeitsschritt 2 "Querys" unter zu bringen, also zu verbinden wie z. B. Union all es bei QMF macht. geht das überhaupt ist meine erste Frage. Wenn ja........
Ich möchte einmal Daten kopieren, und im 2ten Schritt spezifische Werte ansprechen, und aufbereiten lassen. (Wurde im Forum schon gelöst)
Kann mir hierfür jemand einen Lösungsansatz bzw. ein Beispiel liefern.
Meine Codes:
1.: Kopieren aus der Stammdatei in die Arbeitsdatei!
2.: Auswahl treffen aus kopierten Daten
Ich möchte einmal Daten kopieren, und im 2ten Schritt spezifische Werte ansprechen, und aufbereiten lassen. (Wurde im Forum schon gelöst)
Kann mir hierfür jemand einen Lösungsansatz bzw. ein Beispiel liefern.
Meine Codes:
1.: Kopieren aus der Stammdatei in die Arbeitsdatei!
Code:
Private Sub Problem() ' Die Tabelle Zuzahlung
Dim Zeile As Long
Dim ZeileMax As Long
Dim i As Long
' .AutoFilter 4, 1
With Worksheets("Zuza")
Worksheets("Problem").Range("A1:z430").ClearContents ' LÖSCHEN der alten Daten???????
Worksheets("ArbTab").Range("a1:a430").Copy Destination:=Worksheets("Problem").Range("a1") ' Nummer
Worksheets("ArbTab").Range("c1:c430").Copy Destination:=Worksheets("Problem").Range("b1") ' Name
Worksheets("ArbTab").Range("d1:d430").Copy Destination:=Worksheets("Problem").Range("c1") ' Vorname
Worksheets("ArbTab").Range("l1:l430").Copy Destination:=Worksheets("Problem").Range("d1") ' genBis
Worksheets("ArbTab").Range("n1:n430").Copy
Worksheets("Problem").Range("e1").PasteSpecial Paste:=xlValues ' Tage gültig
Worksheets("ArbTab").Range("s1:s430").Copy Destination:=Worksheets("Problem").Range("f1") ' Bemerkung
Worksheets("ArbTab").Range("y1:y430").Copy Destination:=Worksheets("Problem").Range("g1") ' Zahlung
ZeileMax = .UsedRange.Rows.Count
n = 1
For Zeile = 1 To ZeileMax
Next Zeile
End With
End Sub
2.: Auswahl treffen aus kopierten Daten
Code:
Sub test_neu()
Dim a As Long, i As Long
Dim arr As Variant
Dim Header As Boolean
Application.ScreenUpdating = False
a = 1
a = Worksheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row + 1
With Worksheets("Tabelle1")
arr = .Range("A1").CurrentRegion
For i = LBound(arr) + Abs(Header) To UBound(arr)
If arr(i, 6) Like "*A*" Or arr(i, 7) Like "*a*" Or (arr(i, 8) >= 1 And arr(i, 8) <= 90) Then
.Rows(i).Copy _
Destination:=Worksheets("Tabelle2").Rows(a)
a = a + 1
End If
Next i
End With
Application.ScreenUpdating = True
End Sub