14.07.2020, 17:35
Hallo
ich habe keine grosse Ahnung von vba und hoffe somit auf Hilfe von einem Profi.
Wir haben ein Excel Arbeitsmappe, welches von mehreren Personen jeweils als als copy benutzt wird. Innerhalb der Arbeitsmappe wird in es ein Tabellenblatt eine Zeile mit ca. 30 Spalten generiert. Nun möchten wir diese Zeile von der jeweiligen Arbeitsmappe in eine zentrale Arbeitsmappe übertragen und bei Änderungen bei der Source, diese auch wiederum in der zentralen Arbeitsmappe nachführen.
Ich habe etwas "gebastelt" und wenigstens wird ein Eintrag schon Mal übertragen, aber der Update funktioniert in dem Sinne nicht, weil jeweils eine neue Zeile erstellt wird.
Option Explicit
Sub Service_Offering_Update()
Application.ScreenUpdating = False
Dim LastRow As Long
Workbooks.Open "https://company365.sharepoint.com/sites/ServiceManagement/Freigegebene%20Dokumente/SERVICE%20MANAGEMENT%20LIBRARY/1.%20Service%20Katalog/Servicematrix.xlsx?web=1"
Workbooks("Estimator 2.5.xlsm").Worksheets("Offering").Activate
LastRow = Range("Offering").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim rng As Range
Dim foundVal As Range
For Each rng In Sheets("Offering").Range("A5:A" & LastRow)
Set foundVal = Workbooks("Servicematrix.xlsx").Sheets("Servicematrix").Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
If foundVal Is Nothing Then
rng.EntireRow.Copy
Workbooks("Servicematrix.xlsx").Sheets("Servicematrix").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Else
rng.EntireRow.Copy
Workbooks("Servicematrix.xlsx").Sheets("Servicematrix").Cells(Rows.Count, "A").End(xlUp).Offset(0, 0).PasteSpecial xlPasteValues
End If
Next rng
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
ich habe keine grosse Ahnung von vba und hoffe somit auf Hilfe von einem Profi.
Wir haben ein Excel Arbeitsmappe, welches von mehreren Personen jeweils als als copy benutzt wird. Innerhalb der Arbeitsmappe wird in es ein Tabellenblatt eine Zeile mit ca. 30 Spalten generiert. Nun möchten wir diese Zeile von der jeweiligen Arbeitsmappe in eine zentrale Arbeitsmappe übertragen und bei Änderungen bei der Source, diese auch wiederum in der zentralen Arbeitsmappe nachführen.
Ich habe etwas "gebastelt" und wenigstens wird ein Eintrag schon Mal übertragen, aber der Update funktioniert in dem Sinne nicht, weil jeweils eine neue Zeile erstellt wird.
Option Explicit
Sub Service_Offering_Update()
Application.ScreenUpdating = False
Dim LastRow As Long
Workbooks.Open "https://company365.sharepoint.com/sites/ServiceManagement/Freigegebene%20Dokumente/SERVICE%20MANAGEMENT%20LIBRARY/1.%20Service%20Katalog/Servicematrix.xlsx?web=1"
Workbooks("Estimator 2.5.xlsm").Worksheets("Offering").Activate
LastRow = Range("Offering").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim rng As Range
Dim foundVal As Range
For Each rng In Sheets("Offering").Range("A5:A" & LastRow)
Set foundVal = Workbooks("Servicematrix.xlsx").Sheets("Servicematrix").Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
If foundVal Is Nothing Then
rng.EntireRow.Copy
Workbooks("Servicematrix.xlsx").Sheets("Servicematrix").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Else
rng.EntireRow.Copy
Workbooks("Servicematrix.xlsx").Sheets("Servicematrix").Cells(Rows.Count, "A").End(xlUp).Offset(0, 0).PasteSpecial xlPasteValues
End If
Next rng
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub