AW: Anmerkung
21.07.2020 16:21:49
Herby
Hallo Werner
jetzt bin ich schon fast ein ganz klein wenig stolz auf mich, dass ich deinen Code so anpassen konnte, dass nun alles funktioniert. Die Zeilen werden nun wie gewünscht, in den Bereich der intelligenten Tabelle geschrieben.
Ich musste aber die Zeile
With Workbooks("Estimator 2.5.xlsm").Worksheets("Offering"
wieder mit dieser hier ersetzen
With ThisWorkbook.Worksheets("Offering")
Zusammen mit deinem letzten Änderungsvorschlag von
For Each rng In Sheets("Offering").Range("A5:A" & LastRow)
zu
For Each rng In .Range("A5:A" & LastRow)
hat dann eben alles funktioniert. Damit sieht der fertige Code nun wie folgt aus
Option Explicit
Public foundVal As Range
Public boAktualisieren As Boolean
Public boAbbruch As Boolean
Sub Übertragen()
Dim LastRow As Long, rng As Range, raFund As Range
Dim wbZiel As Workbook, wsZiel As Worksheet
Application.ScreenUpdating = False
Set wbZiel = Workbooks.Open("https://upgreat365.sharepoint.com/sites/ServiceManagement/ _
Freigegebene%20Dokumente/SERVICE%20MANAGEMENT%20LIBRARY/1.%20Service%20Katalog/Servicematrix.xlsx?web=1")
Set wsZiel = wbZiel.Worksheets("Servicematrix")
With ThisWorkbook.Worksheets("Offering")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For Each rng In .Range("A5:A" & LastRow)
Set foundVal = wsZiel.Columns("A").Find(what:=rng, LookIn:=xlValues, lookat:=xlWhole)
If foundVal Is Nothing Then
rng.EntireRow.Copy
With wsZiel
Set raFund = .Columns("A").Find(what:="*", LookIn:=xlValues, _
lookat:=xlWhole, searchdirection:=xlPrevious)
If Not raFund Is Nothing Then
.Cells(raFund.Row, "A").Offset(1).PasteSpecial Paste:=xlPasteValues
End If
End With
Else
rng.EntireRow.Copy
UserForm2.Show
If boAbbruch Then
Application.CutCopyMode = False
Exit Sub
End If
If boAktualisieren Then
With wsZiel
.Cells(foundVal.Row, "A").PasteSpecial Paste:=xlPasteValues
boAktualisieren = False
End With
Else
With wsZiel
Set raFund = .Columns("A").Find(what:="*", LookIn:=xlValues, _
lookat:=xlWhole, searchdirection:=xlPrevious)
If Not raFund Is Nothing Then
.Cells(raFund.Row, "A").End(xlUp).Offset(1).PasteSpecial _
Paste:=xlPasteValues
End If
End With
End If
End If
Next rng
End With
'Zieldatei speichern
wbZiel.Save
wbZiel.Close
Application.CutCopyMode = False
Set wbZiel = Nothing: Set wsZiel = Nothing: Set foundVal = Nothing: Set raFund = Nothing
End Sub
Du hattest noch gefragt, wieso die Variablen als public definiert sind, ist das ein Problem und sollte besser geändert werden. Ich habe dazu keinen Plan :(
In jedem Fall noch einmal herzlichen Dank für Deine tolle Ungterstützung
Gruss
Herby
