AW: Liste automatisch füllen
27.09.2018 07:22:57
Maria
Guten Morgen,
Hier der Code für die Ausführung des Datentransfers:
Beschreibung:
CBO1 = Schaltfläche OK
LP1 = User Form
TB1-7= TextBox 1-7
CX1 = Combo Box
AH2:AH161 'Hier werden Lfd-Nr. eingetragen und je nach Anzahl runterkopiert.
AI3:AI161 'Hier werden bestimmte Werte eingetragen und je nach Anzahl runterkopiert.
AJ3:AJ161 'Hier werden bestimmte Kriterien eingetragen und je nach Anzahl runterkopiert.
Diese werden in Zwischentabellen automatisch gelistet und Leerzeilen nicht berücksichtigt.
Das Ergebnis wird in BD2:BF161 angezeigt.
Mit folgendem Code sollen die Daten von BD2:BF161 in AA2:AC161 nur als Werte kopiert werden:
Range("BD2:BF161").Select
Selection.Copy
Range("AA2").Select
Dim s As String
Dim i As Long
With ActiveSheet
i = 1
Do
i = i + 1
s = Cells(i, "AA")
If Len(s) = 0 Then
Cells(i, "AA").Activate
Exit Do
End If
Loop While i
End With
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AA162:AC241").Select
Selection.ClearContents
Lösungssuche:
Daten sollen in AA2:AA161 kopiert werden. Sofern Zellen in AA2:AA161 belegt sind dürfen diese nicht überschrieben werden und soll auf die nächstmögliche freie Zeile springen.
AA= Lfd_Nr
AB= Bestimmte Werte
AC= Bestimmte Kriterien
In AA können manuell Kontrollstandards eingegeben werden. Dann sollten diese Zeilen gesperrt werden.
Hier der gesamte Code
Private Sub CBO1_Click()
Worksheets("Formblatt").Unprotect Password:="xxxxxxx"
Dim TB1 As String
Range("AH2").Select
ActiveCell.Offset(0, 0).Value = LP1.TB1.Value
Dim TB2 As String
Range("AE13").Select
ActiveCell.Offset(0, 0).Value = LP1.TB2.Value
Dim TB3 As String
Range("AE16").Select
ActiveCell.Offset(0, 0).Value = LP1.TB3.Value
Dim TB4 As String
Range("AE19").Select
ActiveCell.Offset(0, 0).Value = LP1.TB4.Value
Dim TB5 As String
Range("AE22").Select
ActiveCell.Offset(0, 0).Value = LP1.TB5.Value
If LP1.TB5.Value = "" Then
MsgBox ("Eingabe Bearbeiter fehlt! ")
Exit Sub
End If
Dim TB6 As String
Range("AE25").Select
ActiveCell.Offset(0, 0).Value = LP1.TB6.Value
Dim TB7 As String
Range("AI2").Select
Range("AI2") = CDbl(LP1.TB7.Value)
Dim CX1 As String
Range("AH1").Select
ActiveCell.Offset(0, 0).Value = LP1.CX1.Value
Range("AH2").Select
Selection.AutoFill Destination:=Range("AH2:AH161"), Type:=xlFillDefault
Range("AH2:AH161").Select
Range("AI2").Select
Selection.Copy
Range("AI3:AI161").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AJ2").Select
Selection.Copy
Range("AJ3:AJ161").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("BD2:BF161").Select
Selection.Copy
Range("AA2").Select
Dim s As String
Dim i As Long
With ActiveSheet
i = 1
Do
i = i + 1
s = Cells(i, "AA")
If Len(s) = 0 Then
Cells(i, "AA").Activate
Exit Do
End If
Loop While i