Как вставить имя открытого файла в xls

[avolon]

Привет чет все облазил
Есть некий макрос который при запуске указываеш файлы он собирает инфу отттуда и все на один лист запихивает
А теперь вопрос
как сделать чтоб когда он (макрос) открыл файл записал в ячейку название файла который открыл, потом добавил результат выполненного макроса,потом снова открыл второй файл опять записал названия файланиже предыдущего результата и т.д
на ум приходит вот такое но немогу понять как приладить к моему

a = Split(ActiveWorkbook.FullName, "\")
Cells(1, 1) = a(UBound(a))

так прикрепляю файлы
и вот код макроса

Sub lastConsolidate()
Dim ws As Worksheet, lr As Long, cnt As Long
Dim Files, wsDataSheet, li As Long, oAwb As String
Files = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Set wsDataSheet = ActiveWorkbook.Sheets("Итог")
For li = LBound(Files) To UBound(Files)
Workbooks.Open Filename:=Files(li)

oAwb = Dir(Files(li), vbDirectory)
    ReDim arr(1 To ActiveWorkbook.Sheets.Count, 1 To 3)
    
    cnt = 0
        For Each ws In Workbooks(oAwb).Sheets
            If ws.Name <> "Итог" And ws.Name <> "Тит.лист" And ws.Name <> "Список телефонов" Then
            cnt = cnt + 1
                     
            lr = ws.Cells(Rows.Count, 2).End(xlUp).Row
            arr(cnt, 1) = ws.Cells(lr, 2): arr(cnt, 2) = ws.Cells(lr, 9): arr(cnt, 3) = ws.Cells(1, 1)
                
        End If
        Next



Workbooks(oAwb).Close False
lr = wsDataSheet.Cells(Rows.Count, 1).End(xlUp).Row
wsDataSheet.Range("a" & lr + 1).Resize(cnt, 3).Value = arr
Next


Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub

[R Dmitry]

For Each ws In Workbooks(oAwb).Sheets
If ws.Name <> "Итог" And ws.Name <> "Тит.лист" And ws.Name <> "Список телефонов" Then
cnt = cnt + 1
a = Split(ActiveWorkbook.FullName, "\")

wsDataSheet.Cells(cnt, 1) = a(UBound(a))
lr = ws.Cells(Rows.Count, 2).End(xlUp).Row
arr(cnt, 1) = ws.Cells(lr, 2): arr(cnt, 2) = ws.Cells(lr, 9): arr(cnt, 3) = ws.Cells(1, 1)

End If
Next

[avolon]

немножко переделал

Sub lastConsolidate()
Dim ws As Worksheet, lr As Long, cnt As Long
Dim Files, wsDataSheet, li As Long, oAwb As String
Files = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Set wsDataSheet = ActiveWorkbook.Sheets("Итог")
For li = LBound(Files) To UBound(Files)
Workbooks.Open Filename:=Files(li)
a = Split(ActiveWorkbook.FullName, "\")



oAwb = Dir(Files(li), vbDirectory)
    ReDim arr(1 To ActiveWorkbook.Sheets.Count, 1 To 3)
    cnt = 0
        For Each ws In Workbooks(oAwb).Sheets
            If ws.Name <> "Итог" And ws.Name <> "Тит.лист" And ws.Name <> "Список телефонов" Then
            cnt = cnt + 1
          
            lr = ws.Cells(Rows.Count, 2).End(xlUp).Row
            arr(cnt, 1) = ws.Cells(lr, 2): arr(cnt, 2) = ws.Cells(lr, 9): arr(cnt, 3) = ws.Cells(1, 1)
                
        End If
        Next
Workbooks(oAwb).Close False
wsDataSheet.Cells(lr + 1, 1) = a(UBound(a))
lr = wsDataSheet.Cells(Rows.Count, 1).End(xlUp).Row
wsDataSheet.Range("a" & lr + 1).Resize(cnt, 3).Value = arr
Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub

но остался вопрос как сделать так чтоб выводил имя файла без разширения xls ??

[Sparkman]

используйте mid(строка,начало,количество)

[avolon]

хм
Тоесть
нгде то сюда

wsDataSheet.Cells(lr + 1, 1) = a(UBound(a))

должен прилепит Mid ??

[Sparkman]

Сообщение от avolon

хм
Тоесть
нгде то сюда

wsDataSheet.Cells(lr + 1, 1) = a(UBound(a))

должен прилепит Mid ??

wsDataSheet.Cells(lr + 1, 1) = MID(a(UBound(a)),1,Len(a(UBound(a)))-4)

[avolon]

Спасибо!!
Сам допер чет с утра голова вообще не робит (((((НОЧЬЮ СПАТЬ НАДА!!