Макросы на копирование данных из нескольких файлов excel в один файл excel

@Just67 · Регистрация: 06.08.2019

Author24 — интернет-сервис помощи студентам

Здравствуйте!

Помогите сделать два макроса в excel, которые будут копировать данные из множества файлов excel в один файл excel.
Я полный новичок в данной теме... Находил различные варианты в интернете, но отредактировать под себя не получается.

Все файлы excel, из которых будут копироваться данные, одинаковой структуры, а файл в который необходимо записать данные другой структуры. Все данные находятся на первом листе.

К примеру:
Первый макрос.
В каждом файле excel необходимые данные для копирования находятся в ячейке C3 и в диапазоне C6 : C13, а собрать все эти данные необходимо в единственном файле excel и расположить в нем нужно так ---> из первого файла C3->A5 (из следующего файла C3->A6 и т.д.), из первого файла диапазон C6 : C13 -> B5 : I5 (из следующего файла C6 : C13 -> B6 : I6 и т.д.) получается из столбца в строку. Данные каждого нового файла с новой строки.

Второй макрос точно такой же и с теми же файлами, но берется диапазон D6 : D13 вместо C6 : C13 и записывается так же, только это уже будет для другого файла.

По факту будут две папки с файлами excel в одной будет работать макрос по диапазону C6 : C13, в другой папке те же файлы только макрос там будет работать по диапазону D6 : D13

Заранее спасибо!

К этой теме прикрепил две папки с образцами файлов из которых будут копироваться данные и файлы в которые все будет собираться.

P.S Буду учиться делать макросы на этом примере и на других что найду...

@Burk · 07.08.2019, 05:33

Just67, включаете макрорекодер (Разработчик - Запись макроса) и проделываете все действия, которые вы написали, потом Остановить запись и получаете макрос ваших действий вручную. Потом подрабатываете его, например, вставляете в цикл по строкам, при этом заменяете конкретный номер строки на переменную цикла.

@Just67 · 07.08.2019, 10:18 **[ТС]**

Спасибо за совет. Макрос я записал своих действий, но дальше для меня не понятно. Как я говорил, я в этом полный новичок(знаний практически нет).
Если вам не трудно, можете написать работающий макрос?
Вот результат записи макроса:

Visual Basic

Sub Макрос3()
'
' Макрос3 Макрос
'
 
'
    Windows("файл 1.xlsx").Activate
    Range("C3").Select
    Selection.Copy
    Windows("Сюда собираются данные из файлов.xlsx").Activate
    Range("A5").Select
    ActiveSheet.Paste
    Windows("файл 1.xlsx").Activate
    Range("C6:C13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Сюда собираются данные из файлов.xlsx").Activate
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Windows("файл 2.xlsx").Activate
    Range("C3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Сюда собираются данные из файлов.xlsx").Activate
    Range("A6").Select
    ActiveSheet.Paste
    Windows("файл 2.xlsx").Activate
    Range("C6:C13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Сюда собираются данные из файлов.xlsx").Activate
    Range("B6").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub

Количество файлов и их название из которых информация копируется не известно.

@Burk · 07.08.2019, 14:19

Just67, ну этот макрос тоже должен работать, хотя его можно значительно упростить. Я могу, конечно, без проверки это сделать т.к. не хочется ещё и создавать ваши файлы с данными. Но можете прислать файлы, тогда с проверкой. Какой вариант вам больше подходит?

Добавлено через 42 минуты
Посмотрите, что получилось из вашего макроса

Visual Basic

Sub Perenos()
'
Dim From As Workbook, Ins As Workbook, Win As Workbook, I As Integer, S As String
Set Ins = Workbooks("Сюда собираются данные из файлов.xlsm")
Ins.Activate
For I = 1 To 2
  Set From = Workbooks("файл " & I & ".xlsx")
  With From.Sheets(1)
     Range("A" & (I + 4)) = .Range("C3")
    .Range("C6:C13").Copy
    Range("B" & (I + 4)).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
         SkipBlanks:=False, Transpose:=True
  End With
Next
End Sub

@Just67 · 07.08.2019, 15:29 **[ТС]**

Не получилось запустить макрос выдал ошибку Run-time error '9': Subscript out of range
макрос останавливается на 7 строке "Set From = Workbooks("файл " & I & ".xlsx")".

И если файлов из которых данные будут копироваться больше двух, то ваш макрос будет копировать со всех файлов в один? Имена файлов так же не известно какие будут и в каком формате.

Скриншот в приложении

@Burk · 07.08.2019, 16:25

Just67, макрос работает, вы что не видите, что имя файлов, из которых беруться данные, должно быть файл 1.xlsx и файл 2.xlsx как в вашем макросе И давайте запустите этот, а что будет дальше, то потом. Конечно надо расширить цикл, если три файла, то и цикл до трёх и т.д., если названия непохожие друг на друга, то нужно будет создать массив имен и обращаться к массивам через него. Вы пока не думайте так далеко, вредно это.
И в начале сообщения нажимайте на мой ник, тогда я буду знать, что есть упоминание в теме
перед числом в имени файла пробел

Добавлено через 6 минут
обращаться к файлам через него

Добавлено через 33 минуты
перед запуском макроса все три файла должны быть загружены в эксель

@Burk · 08.08.2019, 04:47

Just67, а вот так можно грузить любое количество файлов с любыми именами. Но должны быть загружены только те, из которых надо копировать информацию.

Visual Basic

Sub Perenos2()
Dim From As Workbook, Ins As Workbook, I As Integer
Set Ins = Workbooks("Сюда собираются данные из файлов.xlsm")
Ins.Activate: I = 4
For Each From In Workbooks
  If From.Name <> ThisWorkbook.Name Then
    I = I + 1
    With From.Sheets(1)
      Range("A" & I) = .Range("C3")
      .Range("C6:C13").Copy
      Range("B" & I).Select
      Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
           SkipBlanks:=False, Transpose:=True
    End With
  End If
Next
Application.CutCopyMode = False
If I = 4 Then MsgBox "Не загружены файлы с исходной информацией!"
End Sub

@Just67 · 08.08.2019, 12:31 **[ТС]**

Burk, Спасибо за подробное разъяснение. Я когда запускал макрос имена не поменял, после того как поменял и открыл нужные таблицы макрос сделал все как надо.
И последний макрос запустил все работает как надо, спасибо.
Можете еще посоветовать каким образом лучше в макросе сделать проверку на пустую ячейку?
К примеру: если в ячейки "C3" нет данных(пустая), то в ячейку "A" файла "Сюда собираются данные из файлов.xlsm" указывается название файла, в котором ячейка "C3" пустая.

В моем варианте в ячейку записывается название файла с его расширением. Как сделать, чтобы расширение не записывалось?

Код:

Visual Basic

Sub Perenos()
Dim From As Workbook, Ins As Workbook, I As Integer
Set Ins = Workbooks(".Сюда собираются данные из файлов.xlsm")
Ins.Activate: I = 4
For Each From In Workbooks
  If From.Name <> ThisWorkbook.Name Then
    I = I + 1
    With From.Sheets(1)
        If .Range("C3") = "" Then
        Range("A" & I) = From.Name
        Else
      Range("A" & I) = .Range("C3")
        End If
      .Range("C6:C13").Copy
      Range("B" & I).Select
      Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
           SkipBlanks:=False, Transpose:=True
    End With
  End If
Next
Application.CutCopyMode = False
If I = 4 Then MsgBox "Не загружены файлы с исходной информацией!"
End Sub

Добавлено через 10 минут
Burk, Еще было бы интересно узнать каким образом можно сделать проверку на пустые ячейки в диапазоне C6 : C13 и если такие есть, то вместо пустой ячейки записывать "0".

Добавлено через 10 минут
Извиняюсь, что задаю много вопросов.

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

@Burk · 08.08.2019, 15:40

Just67, первый вопрос

Visual Basic

    Range("A" & I) = Left(From.Name, InstrRev(From.Name,".") - 1)
'второй вопрос - видимо имеются в виду нули в копиях этих ячеек файла "Сюда собираются ..."?
'Если так, то после строки 17 вставить
For J = 2 To 9
     If Cells(I, J) = "" Then Cells(I, J) = 0
Next

третий вопрос - У меня не было необходимости вытаскивать значения ячеек из закрытой книги, но подобные темы выплывают регулярно и на этом форуме, последний раз где-то 2-3 месяца назад. Наберите в поиске типа Получить информацию из закрытой книги или обратитесь к Hugo121 или pashulka, они, по-моему, писали ответы, мне бы не хотелось с этим разбираться.

Добавлено через 2 часа 34 минуты
Just67, чтобы не привязываться к имени файла, в который копируется, можно строку 4 в макросе записать так (описание для Ins можно убрать) и удалить строку 3

Visual Basic

1	ThisWorkbook.Sheets(1).Activate: I = 4

@Just67 · 08.08.2019, 17:02 **[ТС]**

Burk, Спасибо, все работает.

@Burk 1846 / 1161 / 354 Регистрация: 11.07.2014 Сообщений: 4,102
	07.08.2019, 05:33	2
	Just67, включаете макрорекодер (Разработчик - Запись макроса) и проделываете все действия, которые вы написали, потом Остановить запись и получаете макрос ваших действий вручную. Потом подрабатываете его, например, вставляете в цикл по строкам, при этом заменяете конкретный номер строки на переменную цикла. 1

@Just67 0 / 0 / 0 Регистрация: 06.08.2019 Сообщений: 5
	07.08.2019, 15:29 [ТС]	5
	Не получилось запустить макрос выдал ошибку Run-time error '9': Subscript out of range макрос останавливается на 7 строке "Set From = Workbooks("файл " & I & ".xlsx")". И если файлов из которых данные будут копироваться больше двух, то ваш макрос будет копировать со всех файлов в один? Имена файлов так же не известно какие будут и в каком формате. Скриншот в приложении Миниатюры 0

@Burk 1846 / 1161 / 354 Регистрация: 11.07.2014 Сообщений: 4,102
	07.08.2019, 16:25	6
	Just67, макрос работает, вы что не видите, что имя файлов, из которых беруться данные, должно быть файл 1.xlsx и файл 2.xlsx как в вашем макросе И давайте запустите этот, а что будет дальше, то потом. Конечно надо расширить цикл, если три файла, то и цикл до трёх и т.д., если названия непохожие друг на друга, то нужно будет создать массив имен и обращаться к массивам через него. Вы пока не думайте так далеко, вредно это. И в начале сообщения нажимайте на мой ник, тогда я буду знать, что есть упоминание в теме перед числом в имени файла пробел Добавлено через 6 минут обращаться к файлам через него Добавлено через 33 минуты перед запуском макроса все три файла должны быть загружены в эксель 1

@Just67 0 / 0 / 0 Регистрация: 06.08.2019 Сообщений: 5
	08.08.2019, 17:02 [ТС]	10
	Burk, Спасибо, все работает. 0