Макрос стягивает данные с других книг

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос стягивает данные с других книг (Макросы/Sub)

lampochka

Дата: Воскресенье, 02.04.2017, 12:57 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Здравствуйте, подскажите, пожалуйста, есть макрос, который стягивает данные с других книг, всё работает, но нужно дополнительно прописать, чтобы в столбце V отображалось имя книги с которой сняты данные.
Например, если с книги "1 файл" он стянул цифры, то в столбце V напротив цифр будет именно имя "1 файл" и так далее.

[vba]

Код

Sub Кнопка1_Щелчок()
iPath = "C:\отчёты\"
iFail = Dir(iPath)
aFail = ActiveWorkbook.Name
Do While iFail <> ""
    Workbooks.Open Filename:=iPath & iFail
    ps = Range("A" & Rows.Count).End(xlUp).Row
    Set otkuda = Sheets("лист1").Range("A2:G" & ps)
    Windows(aFail).Activate
    ps = Range("A" & Rows.Count).End(xlUp).Row + 1
    Set kuda = Sheets("лист1").Range("A" & ps)
    otkuda.Copy kuda
    Windows(iFail).Close
    iFail = Dir
Loop
End Sub

[/vba]

тема создана на другом сайте:
http://www.planetaexcel.ru/forum....kh-knig

К сообщению приложен файл: 9251884.rar (20.3 Kb)

Сообщение отредактировал lampochka - Воскресенье, 02.04.2017, 12:57

Ответить

lampochka

Дата: Воскресенье, 02.04.2017, 16:31 | Сообщение № 2

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Уважаемый Kuzmich дал решение:

[vba]

Код

Sub Кнопка1_Щелчок()
Dim FirstRow As Integer
Dim EndRow As Integer
iPath = "C:\отчёты\"
iFail = Dir(iPath)
aFail = ActiveWorkbook.Name
  FirstRow = 2
Do While iFail <> ""
    Workbooks.Open Filename:=iPath & iFail
    ps = Range("A" & Rows.Count).End(xlUp).Row
      EndRow = FirstRow + ps - 2
    Set otkuda = Sheets("лист1").Range("A2:G" & ps)
    Windows(aFail).Activate
    ps = Range("A" & Rows.Count).End(xlUp).Row + 1
    Set kuda = Sheets("лист1").Range("A" & ps)
    otkuda.Copy kuda
    Range("V" & FirstRow & ":V" & EndRow) = iFail
      FirstRow = EndRow + 1
    Windows(iFail).Close
    iFail = Dir
Loop
End Sub

[/vba]

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос стягивает данные с других книг (Макросы/Sub)

Страница 1 из 1
1