Имя файла при переносе данных из других файлов

[Надежда1970]

Здраствуйте...... Помогите мне пожалуйста !!!!

Я скачала у Вас макрос, который дает возможность собирать информацию из закрытых файлов с один. Спасибо, очень хорошо работает !!!
Мне очень нужно, стобы при ререносе данных из закрытых файлов, в конце каждой строчки указывалось имя файла,с которого перешла данная информация.

Заранее огромное спасибо

[Hugo121]

И где тот макрос?

[Надежда1970]

Вот, посылаю

[Надежда1970]

Помогите..... плз......

[Надежда1970]

Возможен и другой вариант. Например, при сохранении данных в файлах (из которых идет перенос информации в общий файл) в определенную папку в конце каждой заполненной строчки должно автоматически выставляться имя файла. Тогда дополнительно не надо будет ничего делать. Но как это сделать?

[Hugo121]

Попробуйте так:

Option Explicit

Sub Consolidated_Range_of_Books_and_Sheets()
    Dim iPivotRange As Range, iDestinationRange As Range, iBeginRange As Range, Sheet
    Dim iRngAddress As String, oAwb As String, DataSheet As String, iCopyAddress As String, oFile
    Dim lLastrow As Long, lLastRowMyBook As Long
    Dim iLastColumn As Integer
    Dim Str() As String

    ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
    DataSheet = ThisWorkbook.ActiveSheet.Name
    On Error Resume Next
    Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
                                           "1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
                                           vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
    If iBeginRange Is Nothing Then Exit Sub
    On Error GoTo 0
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .InitialFileName = "*.*"
        .Title = "Выберите файлы"
        If .Show = False Then Exit Sub
        For Each oFile In .SelectedItems
            Workbooks.OpenText Filename:=oFile
            oAwb = Dir(oFile, vbDirectory)

            Application.ScreenUpdating = False
            Workbooks(oAwb).Activate
            For Each Sheet In Sheets
                Sheet.Activate
                Select Case iBeginRange.Count
                Case 1
                    lLastrow = Cells(1, 1).SpecialCells(xlLastCell).Row
                    iLastColumn = Cells.SpecialCells(xlLastCell).Column
                    iCopyAddress = Range(Cells(iBeginRange.Row, iBeginRange.Column), Cells(lLastrow, iLastColumn)).Address
                Case Else
                    iCopyAddress = iBeginRange.Address
                    lLastrow = iBeginRange.Rows.Count
                    iLastColumn = iBeginRange.Columns.Count
                End Select
                lLastRowMyBook = ThisWorkbook.Sheets(DataSheet).Cells.SpecialCells(xlLastCell).Row
                iRngAddress = Range(Cells(lLastRowMyBook, 1), Cells(lLastRowMyBook + lLastrow, iLastColumn)).Address
                Sheet.Range(iCopyAddress).Copy Destination:=ThisWorkbook.Sheets(DataSheet).Range(iRngAddress)
                ThisWorkbook.Sheets(DataSheet).Range(iRngAddress)(1).Offset(, Sheet.Range(iCopyAddress).Columns.Count) = oFile
            Next Sheet
            Workbooks(oAwb).Close False
        Next oFile
    End With
    Application.ScreenUpdating = True
End Sub

Добавил одну строку:

                ThisWorkbook.Sheets(DataSheet).Range(iRngAddress)(1).Offset(, Sheet.Range(iCopyAddress).Columns.Count) = oFile

[Надежда1970]

Спасибо за помощь...... хотя это не работает

Во первых, из четырех выбранных файлов переносит почему-то только 2, пишет имя файла только в конце первой строчки и дает сбой ((

[Hugo121]

"переносит почему-то только 2" - без этой строки переносит все?
"пишет имя файла только в конце первой строчки" - так и было задумано.
Уберите (1) - будет писать в каждой ячейке.
А если строку написать так:

                ThisWorkbook.Sheets(DataSheet).Range(iRngAddress).Columns(1).Offset(, Sheet.Range(iCopyAddress).Columns.Count) = oFile

То будет писать в каждой строке.

[Надежда1970]

Таак...... теперь ситуация похуже....
Переносит значения следующим образом:
1. Переносит название файлов на Лист 4 (т.е. в сводном файле автоматически откываются дополнительно 3 новых листа (но они остаются пустыми)
2. Другие данные не переносятся

[Hugo121]

Надежда1970, что Вы там творите?
Я всего лишь добавил в существующий код одну строку, которая всего лишь заносит имя файла в одну ячейку.
И у меня всё работает.