Abgleich und dazufügen
Andre
ich brauche dringend Hilfe für die genaue Deklaration in meinem Makro.
Da Makro sollte nacheinander jedes Excel Sheet in einem Ordner öffnen und danach in Spalte A einen Abgleich mit der Zieldatei machen und bei Treffer Spalte A farblich makieren und die Werte von Spalte B bis Ar kopieren. Falls der Wert nicht vorhanden ist einfach bei der Zieldatei unten dranhängen.
Leider kann ich die Quelle nicht sauber deklarieren, damit das Program immer weiss, dies ist die Quelle und das ist das Ziel.
Bei Set Quelle = ActiveWorkbook kommt der Fehler Run timer error '13'
Kann mir einer auf die Sprünge helfen?
Sub Update()
Dim ZeilePreli As Range
Dim LZData As Range
Dim Zeile, LetzteZeile, IndexPreli As Integer
Dim LZDataRow As Integer
Dim strfile As String
Dim Ziel, Quelle As Worksheets
Dim fso As Variant
Dim oFile As Variant
Dim ID As Range
Const sSourcePath = "D:\Arbeitsdateien\Procurement Savings\files"
Set Ziel = ActiveWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")
For Each oFile In fso.GetFolder(sSourcePath).Files
'nur .xls-Dateien bearbeiten
If LCase(Right(oFile.Name, 4)) = ".xls" Then 'nur .xls-Dateien bearbeiten
Application.Workbooks.Open (oFile.Path)
Set Quelle = ActiveWorkbook
Zeile = 5 'Startzeile für den Abgleich
LetzteZeile = Ziel.Worksheets(Measures).Cells(Cells.Rows.Count, 1).End(xlUp).row ' _
Ermittlung der letzten Zeile in Zieldatei
Do While Quelle.Worksheets(Measures).Cells(Zeile, 1) "" ' Solange Zeilen in _
Quelle
IndexPreli = Quelle.Worksheets(Measures).Cells(Zeile, 1).Value ' ID aus Quelle
Set ZeilePreli = Ziel.Worksheets(Measures).Range("A:A").Find(IndexPreli) ' In _
Ziel den Bezug für die ID suchen
If Not ZeilePreli Is Nothing Then ' In Ziel einen Bezug für ID aus input gefunden
Ziel.Worksheets(Measures).Cells(ZeilePreli.row, 1).Interior.ColorIndex = 33 ' _
gefundene ID in Data markieren
Quelle.Worksheets(Measures).Range(Cells(ZeilePreli.row, 1), Cells(ZeilePreli.row, _
31)).Copy Destination:=Ziel.Worksheets(Measures).Cells(Zeile, 1)
Else ' Wenn in Ziel "Data" kein Bezug für die ID aus der gerade bearbeiteteten _
Zeile in Quelle "Data" gefunden werden kann
Quelle.Worksheets(Measures).Range(Cells(Zeile, 1), Cells(Zeile, 31)).Copy ' _
Datenbereich aus input (Ctrl-C)
Set LZData = Ziel.Range("A5:A65536").Find("") ' Bezug auf erste Spalte Data ab A5
LZDataRow = LZData.row ' Zeilennummer der ersten leere _
Zelle in Spalte A
' MsgBox LZDataRow
Ziel.Worksheets(Measures).Activate
Cells(LZDataRow, 1).Select 'Spalte B der ersten leeren Zeile _
in Data
Selection.PasteSpecial Paste:=xlPasteValues ' Werte einfügen (ALT B,F,W)
End If
Zeile = Zeile + 1 ' Nächste Zeile aus Quelle "data" bearbeiten
Loop
End If
Next 'Datei
MsgBox "Fertig"
End Sub
Ich wollte gerne
ich würde gerne eine Master Datei haben und