Помогите перевести на VBA

[EducatedFool]

Редактор ВБА выбает ошибку вот в этой строчке

А Вы прочитайте эту строку внимательно:
Wb.Worksheets("Лист1").Range("a2:e5").Copy ThisWorkbook.Worksheets(1).Range("A 1")

У Вас во всех открываемых книгах присутствует лист с таким именем?

[SAS888]

Редактор ВБА выбает ошибку

А в открываемой книге есть лист с именем "Лист1"?

[never_mind]

а то что он копирует из всех перебираемых файлов поверх ранее скопированного это как можно обойти?

[never_mind]

Да. есть. не из-за кодировки ошибка. может он плохо понимает сетевые диски. если обрабатывать файлы с локального диска, то ошибки не возникает.

[EducatedFool]

а то что он копирует из всех перебираемых файлов поверх ранее скопированного это как можно обойти?

Конечно, можно.

Но Вы же ни слова не написали про то, откуда и куда должны копироваться данные...

[never_mind]

Из одного файла в другой. не ради же процесса) сорри за мутные пояснения. у меня уже мозг кипит.
как можно изменить Wb.Sheets(1).Range("A1:B10").Copy ThisWorkbook.Sheets(1).Range("A1")
добавив условие "если ячейка не пустая"?

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

[EducatedFool]

сорри за мутные пояснения

Пояснения не мутные.
Вы просто не сформулировали задачу.

Надо примерно так:

Из каждого найденного в выбранной папке файла с листа Лист2 копируем диапазон d5:j32, и производим вставку на Лист1 текущего документа(из которого запускается макрос), начиная с первой пустой ячейки в строке 4.
Над вставленным блоком (в 3-ю строку) пишем имя файла, из которого взяты данные.

Когда сформулируете задачу подобным образом, тогда и получите ответ.

[never_mind]

Из каждого найденного в выбранной папке файла с листа Лист2 копируем диапазон d5:j32, и производим вставку на Лист1 текущего документа(из которого запускается макрос), начиная с первой пустой ячейки.
В колонке справа от вставленного диапазона вносим имя исходного файла для каждой вставленной строки

[never_mind]

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


Sub КопированиеИзФайлов()

Application.ScreenUpdating = False
Dim WB As Workbook

'определяем перемнную для копируемого файла

MyPath = InputBox("Enter path", "Path", CurDir)
'просим пользователя ввести путь к нужным файлам

If Dir(MyPath, vbDirectory) = "" Then MsgBox "Такая папка не найдена", vbCritical: Exit Sub
'если папка не найдена, то выдаем сообщение и прерываем процесс


If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'если нет слеша в конце пути добавляем


Filename = Dir(MyPath & "*.xls")
'составляем путь и шаблон имени файла для перебора компандой Dir

Dim coll As New Collection
'создаем коллекцию, в которую надо довавить имена файлов

Do While Filename <> ""
'пока имя в файла не обратится в пустую строку добавляем файлы в коллекцию

coll.Add MyPath & Filename
Filename = Dir()
Loop

If coll.Count = 0 Then MsgBox "В выбранной папке не обнаружены файлы Excel", vbCritical: Exit Sub
'если в папке нет нужных файлов, прерываем процесс


For Each file In coll

'устанавливаем условия для копирования

Set WB = Workbooks.Open(file)
'задаем рабочей книгу, которая открывается по ссылке из коллекции
Dim name As String
name = InputBox("Enter sheet name", "Sheet", "Лист1")


Do While diap1 <> ""
c = c + 1
diap1 = WB.Worksheets(1).Range(Cells(1, 1), Cells(c, 1))
Loop
'копировать будем массив до последней не пустой ячейки

Do While diap2 <> ""
a = a + 1
diap2 = ThisWorkbook.Worksheets(1).Range(Ce lls(a, 1))
Loop


'вставлять будем в последнюю пустую ячейку

If Not WB Is Nothing Then
WB.Worksheets(1).Range(Cells(1, 1), Cells(c, 1)).Copy
ThisWorkbook.Worksheets(1).Range(Ce lls(a, 1)).Paste
End If
'усли все впорядке то производим копирование


ThisWorkbook.Worksheets(1).Range(Ce lls(a, 1), Cells(b, 1)) = 3
'приписываем диапазону ячеек значения равные названию файла
Do While diap3 <> ""
b = b + 1
diap3 = ThisWorkbook.Worksheets(1).Range(Ce lls(a, 1))
Loop
'присваиваем их от начала вставленного диапазона до конца

WB.Close False
'закрываем книгу из которой копировалось

Next file
'берем следующий файл из коллекции
End Sub

[EducatedFool]

Лучше как-то так:

Sub КопированиеИзФайлов()
    Application.EnableEvents = False    ' на случай присутствия макросов в открываемых файлах
    Dim WB As Workbook, name As String

    'определяем перемнную для копируемого файла

    MyPath = InputBox("Enter path", "Path", CurDir)    'просим пользователя ввести путь к нужным файлам

    If Dir(MyPath, vbDirectory) = "" Then MsgBox "Такая папка не найдена", vbCritical: Exit Sub
    'если папка не найдена, то выдаем сообщение и прерываем процесс

    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"    'если нет слеша в конце пути добавляем

    Filename = Dir(MyPath & "*.xls")    'составляем путь и шаблон имени файла для перебора компандой Dir

    Dim coll As New Collection    'создаем коллекцию, в которую надо довавить имена файлов

    Do While Filename <> ""        'пока имя в файла не обратится в пустую строку добавляем файлы в коллекцию
        coll.Add MyPath & Filename: Filename = Dir()
    Loop

    If coll.Count = 0 Then MsgBox "В выбранной папке не обнаружены файлы Excel", vbCritical: Exit Sub
    'если в папке нет нужных файлов, прерываем процесс

    Application.ScreenUpdating = False

    Dim ThisSheet As Worksheet: Set ThisSheet = ThisWorkbook.Worksheets(1)
    Dim OpenedSheet As Worksheet

    With ThisSheet
        For Each file In coll
            If file <> ThisWorkbook.FullName Then    ' чтобы не открыть эту самую книгу

                Set WB = Workbooks.Open(file)    ' пытаемся открыть файл
                If Not WB Is Nothing Then    ' дальше продолжаем, только если книга удачно открылась
                    Application.StatusBar = "Обрабатывается книга  " & WB.FullName  ' выводим в строку состояния
                    Set OpenedSheet = WB.Worksheets(1)
                    ' name = InputBox("Enter sheet name", "Sheet", "Лист1") ' зачем запрашивать имя листа?
                    ' нигде ведь это имя не используется...

                    With OpenedSheet
                        'вставлять будем в последнюю пустую ячейку
                        Dim ДиапазонДляКопирования As Range    ' на листе OpenedSheet
                        Set ДиапазонДляКопирования = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
                    End With

                    Dim ЯчейкаДляВставки As Range    ' на листе ThisSheet
                    Set ЯчейкаДляВставки = .Cells(.Rows.Count, 1).End(xlUp)

                    ДиапазонДляКопирования.Copy ЯчейкаДляВставки
                End If

                ЯчейкаДляВставки.Next.Resize(ДиапазонДляКопирования.Rows.Count) = WB.name
                'приписываем диапазону ячеек значения равные названию файла

                WB.Close False        'закрываем книгу из которой копировалось (без сохранения)

            End If
        Next file    'берем следующий файл из коллекции
    End With
    ThisSheet.Range("1:2").EntireColumn.AutoFit
    Application.EnableEvents = True
    Application.StatusBar = ""    ' очищаем строку состояния
End Sub

PS: Не забывайте использовать теги [CОDE] ... [/CОDE] для оформления кода.