Zellen mit Dateinamen im Ordner vergl.

Forumthread: Zellen mit Dateinamen im Ordner vergl.

18.02.2021 07:48:35

Alex

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

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zellen mit Dateinamen im Ordner vergl.

18.02.2021 13:13:31

fcs

AW: Zellen mit Dateinamen im Ordner vergl.

18.02.2021 13:13:31

fcs

Hallo Alex,
hier dein Makro angepasst, sodass die Dateinamen korrekt geprüft werden und die Werte aus den gefundenen Dateien übertragen werden.
LG
Franz

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.

Forumthread: Zellen mit Dateinamen im Ordner vergl.

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread