Поиск файла по содержимому ячейки

Привет! Имеется файл excel с заполненным столбцом B, нужно перебрать значения в этом столбце и как только макрос находит первую заполненную ячейку, начинает искать в той же папке где находится excel, .docx файл с таким же названием, что и текст в ячейке. Если находит такой файл, то создает в данном excel файле новый лист с тем же названием, если не находит, то ищет дальше до последней заполненной ячейки. Подскажите пожалуйста, как это сделать.
2 ответа

AlexFlash27, Привет.Столбец "B" для нижеприведенного должен быть заполнен с1-ой строки..
Sub FOR_ALEX()
m = 0
PTH = ThisWorkbook.Path
FN = Dir(PTH & "\*.docx", vbNormal)
ReDim SHName(ThisWorkbook.Sheets.Count)
For i = 1 To ThisWorkbook.Sheets.Count
SHName(i - 1) = Sheets(i).Name
Next
 
ReDim S(m)
      Do
           If FN = "" Then Exit Do
           S(m) = Mid(FN, 1, Len(FN) - 5)
           m = m + 1
           ReDim Preserve S(m)
           FN = Dir()
     Loop
   
 
For i = LBound(S) To UBound(S) - 1
  For j = LBound(SHName) To UBound(SHName)
     If S(i) = SHName(j) Then S(i) = ""
Next
Next
 
For i = i = LBound(S) To UBound(S) - 1
If S(i) <> "" Then Worksheets.Add.Name = S(i)
Next
 
End Sub


Спасибо работает, а еще вопрос: У меня есть код, который ищет слово в word файле по его "окружению", и копирует его в определенную ячейку файла excel:
Sub primer()
Dim Word As Object
Dim WordDoc As Object
Dim r, f As Boolean, fO As Long
Set Word = CreateObject("Word.Application")
Set WordDoc = Word.Documents.Open(Filename:=Application.ThisWorkbook.path & "\Пример.docx")
 
Set r = WordDoc.Range
Do
With r.Find
    .ClearFormatting
    .Text = "дисциплина *относится"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    If .Execute Then
                If f Then
                    If r.Start = fO Then
                Exit Do
                    End If
                Else
                    fO = r.Start
                    f = True
                End If
                WordDoc.Range(r.Start + 11, r.End - 9).Copy
                Range("C4").Select
                ActiveSheet.Paste
 
                Set r = WordDoc.Range(r.End, r.End)
            Else
 
                Exit Do
            End If
        End With
    Loop
Как совместить это код и код который вы написали, чтобы после того как макрос находит в папке word файл с таким же именем как и значения ячейки из столбца B, он открывал его, копировал нужное слово, вставлял скопированное из word слово на второй (уже созданный) лист в excel? А если не находит в папке файл с таким же именем, то уведомляет что такого файла нет.