AW: Meinst du das hier, ...
25.04.2019 19:42:31
Werner
Hallo Chris,
versuch den mal hier. Beim anderen hatte ich viel zu sehr "um die Ecke" gedacht.
Die Datei kann ich im Moment nicht hochladen. Code ist für die letzte Version der Datei, bei der die Daten auf den zwei verschiedenen Blättern sind.
Private Sub CommandButton1_Click()
Dim loStartzeileQuelle As Long, loStartzeileZiel As Long
Dim loSpalteQuelle As Long, loSpalteZiel As Long
Dim loEndeBlock1 As Long, loLetzteQuelle As Long
Dim loEndeKomplett, loSpalteFertig As Long
Dim loEndeFertig As Long, raFund As Range
'Startzeile Qelldaten
loStartzeileQuelle = 1 'Zeile 1
'Startzeile Zieldaten
loStartzeileZiel = 1 'Zeile 1
'Spalte Zieldaten
loSpalteZiel = 8 'Spalte H
'Spalte mit fertigen Daten
loSpalteFertig = loSpalteZiel + 7
Application.ScreenUpdating = False
If Worksheets("Generator").Range("A12") = "Ja" Then
loSpalteQuelle = loSpalteZiel + 2
ElseIf Worksheets("Generator").Range("A12") = "Nein" Then
loSpalteQuelle = loSpalteZiel + 1
End If
With Worksheets("Tabelle1")
.Columns(loSpalteFertig).ClearContents
.Columns(loSpalteFertig + 1).ClearContents
Set raFund = .Columns(loSpalteZiel).Find(what:="*", LookIn:=xlValues, _
lookat:=xlWhole, searchdirection:=xlPrevious)
If Not raFund Is Nothing Then
loEndeBlock1 = raFund.Offset(1).Row
End If
loLetzteQuelle = .Cells(.Rows.Count, loSpalteQuelle).End(xlUp).Row
.Range(.Cells(loStartzeileQuelle, loSpalteQuelle), .Cells(loLetzteQuelle, loSpalteQuelle)). _
Copy
.Cells(loEndeBlock1, loSpalteZiel).PasteSpecial Paste:=xlPasteValues
loEndeKomplett = .Cells(.Rows.Count, loSpalteZiel).End(xlUp).Row
.Range(.Cells(loStartzeileZiel, loSpalteZiel), .Cells(loEndeKomplett, loSpalteZiel)).Copy
.Cells(loStartzeileQuelle, loSpalteFertig).PasteSpecial Paste:=xlPasteValues
.Cells(loStartzeileQuelle, loSpalteFertig).ClearContents
.Range(.Cells(loEndeBlock1, loSpalteZiel), .Cells(loEndeKomplett, loSpalteZiel)). _
ClearContents
.Columns(loSpalteFertig).RemoveDuplicates Columns:=1, Header:=xlNo
loEndeFertig = .Cells(.Rows.Count, loSpalteFertig).End(xlUp).Row
.Range(.Cells(loStartzeileQuelle, loSpalteFertig + 1), .Cells(loEndeFertig, loSpalteFertig + _
1)) _
.FormulaR1C1 = "=IF(RC[-1]="""",0,ROW())"
.Range(.Cells(loStartzeileQuelle, loSpalteFertig), .Cells(loEndeFertig, loSpalteFertig + 1)) _
_
.RemoveDuplicates Columns:=2, Header:=xlNo
loEndeFertig = .Cells(.Rows.Count, loSpalteFertig).End(xlUp).Row
.Range(.Cells(loStartzeileQuelle + 1, loSpalteFertig), .Cells(loEndeFertig, loSpalteFertig)) _
.Copy
End With
Set raFund = Nothing
End Sub
Gruß Werner