Zellen mit Dateinamen im Ordner vergl.

Hallo Zusammen,
nach Tagen der Suche stehe ich aufm Schlauch,
Habe alle mögliche Codes ausprobiert bezüglich meines Problems, funktionierte leider nichts.
Nun zu dem Problem:
Ich habe eine Master Datei mit Liste der Namen von Exceldateien sowie viele unterschiedliche ExcelDateien die in einem Ordner mit dieser MasterDatei sind.
Nun Möchte ich die Liste aus MasterDatei (ZellenWerte) mit ExcelDateienNamen vergleichen, und wenn sie übereinstimmen die Werte aus diesen ExcelDatein von z.B. B4:B10 nach Master Datei in die Nachbarzelle der übereinstimmten Namen von der Liste übertragen in die zb. G5:K5 Es sind Immer die gleichen Ausgangszellen, nur die Zielzellen sind immer unterschiedlich.
Ich hoffe da kann mir jemand helfen Freundliche Grüße
Alex
Bisherige (nicht) Fortschritte: allerdings nur Vergleich: funktz trotzdem nicht :(
Sub Dateien_prüfen()
Dim cDir As String, sListe As String
Dim i As Long
Dim bExist As Boolean
Const sPath As String = "C:" 'Anpassen
sListe = "Datei" & vbTab & vbTab & "Vorhanden?" & vbCrLf
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1) > "" Then
If Dir(sPath & Cells(i, 1)) > "" Then
bExist = True
Else
bExist = False
End If
sListe = sListe & Cells(i, 1) & vbTab & vbTab & bExist & vbCrLf
End If
Next i
MsgBox sListe
End

Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Sub Dateien_prüfen() Dim sListe As String Dim i As Long Dim bExist As Boolean Dim wkbQ As Workbook, wksQ As Worksheet Dim wksZ As Worksheet Dim sPath As String sPath = ActiveWorkbook.Path & "\" 'ggf. anpassen Set wksZ = ActiveSheet sListe = "Datei" & vbTab & vbTab & "Vorhanden?" & vbCrLf Application.ScreenUpdating = False With wksZ For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row 'Startzeile ggf. Anpassen If .Cells(i, 1) "" Then If Dir(sPath & .Cells(i, 1).Text) > "" Then bExist = True Else bExist = False End If sListe = sListe & .Cells(i, 1).Text & vbTab & vbTab & bExist & vbCrLf If bExist = True Then Set wkbQ = Application.Workbooks.Open(sPath & .Cells(i, 1).Text, ReadOnly:=True) Set wksQ = wkbQ.Worksheets(1) wksQ.Range("B4:B10").Copy .Cells(i, 7).PasteSpecial Paste:=xlPasteAll, Transpose:=True 'kopieren nach Spalte _ G:M in Zeile Application.CutCopyMode = False wkbQ.Close savechanges:=False Set wksQ = Nothing Set wkbQ = Nothing End If End If Next i End With Application.ScreenUpdating = True MsgBox sListe End Sub

Beliebteste Forumthreads (12 Monate)

Zellen mit Dateinamen im Ordner vergl.

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread