Hallo,
dieses kleine Programm funkktioniert nicht, die Werte werden nicht ausgegen (ab v = 2 to lastrow bis zum Schluss). Das Programm enthält keinen Synthaxfehler, es stoppt leider nach dem Kopieren einfach. Kann mir jemand helfen?
Sub Aktualisieren()
Dim x As Integer
Dim lastrow As Long
Dim v As Long
Dim u As Long
lastrow = Worksheets("KPM").Cells(Rows.Count, 2).End(xlUp).Row
Range("A2:H8000").Select
Selection.ClearContents
For x = 2 To lastrow
Worksheets("Übersicht").Cells(x, 1) = Worksheets("KPM").Cells(x, 1)
Worksheets("Übersicht").Cells(x, 2) = Worksheets("KPM").Cells(x, 2)
Worksheets("Übersicht").Cells(x, 3) = Worksheets("KPM").Cells(x, 5)
Worksheets("Übersicht").Cells(x, 4) = Worksheets("KPM").Cells(x, 8)
Worksheets("Übersicht").Cells(x, 5) = Worksheets("KPM").Cells(x, 14)
Worksheets("Übersicht").Cells(x, 6) = Worksheets("KPM").Cells(x, 33)
Next
lastrow = Worksheets("Begehren").Cells(Rows.Count, 2).End(xlUp).Row
For v = 2 To lastrow
If Worksheets("Übersicht").Cells(x, 6).Value = Worksheets("Begehren").Cells(v, 2) Then
Worksheets("Übersicht").Cells(x, 7) = Worksheets("Begehren").Cells(v, 7)
End If
Next
lastrow = Worksheets("TI").Cells(Rows.Count, 2).End(xlUp).Row
For u = 2 To lastrow
If Worksheets("KPM").Cells(x, 14) = Worksheets("TI").Cells(u, 4) Then
Worksheets("Übersicht").Cells(x, 8) = Worksheets("TI").Cells(u, 30)
End If
Next
End Sub
|