Makro abfangen für bearbeitete zellen
22.07.2016 12:24:21
stefan
ich habe folgendes Problem und brauche eine Lösung. Mein unten eingefügtes Makro soll eine Spalte mit Projektnamen mit einer anderen Spalte mit Projektnamen einer Aushilfsdatei vergleichen und sobald der zugehörige Projektname in der Aushilfsdatei gefunden wurde, die in der nächsten Spalte stehende Projektnummer und den korrekt geschriebenen Projektnamen in die Original Excel-Datei übernehmen. Das Problem besteht, wenn ich das Makro ein zweites mal starte, jetzt in der originalen Excel-Datei der korrekte Name, der beim ersten Ausführen übernommen wurde mit dem falschen Namen der Aushilfsdatei vergleicht, somit kein Ergebnis findet und die Spalte mit den Projektnummern komplett löscht. Ich habe daran gedacht den Code so zu verändern, dass bereits beareitete Datensätze nicht angerüghrt warden, sondern nur die Datensätze, die neu eingefügt wurden.
Option Explicit
Sub Projectname_und_ID()
Dim ProjectName As String
Dim ProjectNumber As String
Dim i As Integer
Dim x As String
Dim z As Range
Dim NamenSharepoint As String
Dim error As Boolean
Workbooks.Open "C:\Users\........"
i = 2
While Workbooks("October to June Report NPI GOA.xlsm").Worksheets("Tabelle1").Range("E" & i). _
Value ""
x = Workbooks("October to June Report NPI GOA.xlsm").Worksheets("Tabelle1").Range("E" & _
i).Value
With Workbooks("PNandID.xlsx").Worksheets("Tabelle1").Range("A:Z")
Set z = .Find(x)
If Not z Is Nothing Then
ProjectNumber = z.Offset(0, 1).Value
NamenSharepoint = z.Offset(0, 3).Value
Else
End If
End With
Workbooks("October to June Report NPI GOA.xlsm").Worksheets("Tabelle1").Range("F" & i). _
Value = ProjectNumber
If NamenSharepoint "" Then
Workbooks("October to June Report NPI GOA.xlsm").Worksheets("Tabelle1").Range("E" & i). _
Value = NamenSharepoint
End If
i = i + 1
ProjectName = ""
Wend
If error = True Then MsgBox ("Projekt nicht gefunden, Bitte pflegen Sie die Aushilfsdatei _
PNandID.xlsx!")
End Sub