Здравствуйте, у меня есть несколько(150) файлов с одинаковой шапкой, мне нужно чтобы все строки с каждого отдельного файла копировались в один общий. Пример во вложении: первая строка содержит заголовок, он в каждом файле одинаковый. Ниже строки с данными которые нужно объединять, то есть, из каждого файла брать строки и добавлять их одна под другую. В каждом файле примерно 2-4 строки. Файлы с расширением .csv/ Во вложении у меня макрос, но он объединяет данные только с листов одного файла, а как сделать для множества файлов сsv я не знаю...Подскажите, пожалуйста!
Здравствуйте, у меня есть несколько(150) файлов с одинаковой шапкой, мне нужно чтобы все строки с каждого отдельного файла копировались в один общий. Пример во вложении: первая строка содержит заголовок, он в каждом файле одинаковый. Ниже строки с данными которые нужно объединять, то есть, из каждого файла брать строки и добавлять их одна под другую. В каждом файле примерно 2-4 строки. Файлы с расширением .csv/ Во вложении у меня макрос, но он объединяет данные только с листов одного файла, а как сделать для множества файлов сsv я не знаю...Подскажите, пожалуйста!l-lisa
l-lisa, Добрый день. Мне уже пора убегать с работы, но по описанию очень схоже с одним из моих файлов. Если в макросах немножко ориентируетесь то посмотрите, может разберетесь.
[vba]
Код
Sub CopyAllBook() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.CutCopyMode = False Dim wb As Workbook q = ThisWorkbook.Name
'открываем все книги в папке рабочие (там храним файлы от регионов) Dim MyName As String Dim MyPath As String Dim sPath As String ' тут вставил MyPath = "D:\Мои документы\01 - Отчеты и Анализы\01 - План-Факт\План\План по менеджерам\РЕГИОНЫ\" MyName = Dir(MyPath & "*.xlsx") Do While MyName <> "" sPath = MyPath + MyName ' тут вставил Excel.Application.Workbooks.Open sPath ' тут изменил MyName = Dir Loop
'после открытия активируем основную рабочую книгу Workbooks(q).Activate
'копируем в основную книгу данные с книг от регионов For Each wb In Application.Workbooks LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 If wb.Name <> q Then ' wb.Activate LR = wb.Worksheets(1).Cells(17, 1).End(xlUp).Row
wb.Worksheets(1).Unprotect ("000") With wb.Worksheets(1).Range("A3:O" & LR) 'во всем коде нужно поменять лишь в этой строке последний столбец в зависимости от к-во тов.групп. .Copy .PasteSpecial Paste:=xlPasteValues .Copy End With
With Selection .HorizontalAlignment = xlCenter .Font.Bold = True .Font.Italic = False .Font.Size = 10 .Font.Name = "Calibri" End With wb.Close End If Next [A1].Activate Application.CutCopyMode = True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba]
в этой строке нужно указать путь где лежат Ваши файлы (те которых 150 штук) [vba]
Код
MyPath = "D:\Мои документы\01 - Отчеты и Анализы\01 - План-Факт\План\План по менеджерам\РЕГИОНЫ\"
[/vba] Основной файл не должен быть в этой папке
l-lisa, Добрый день. Мне уже пора убегать с работы, но по описанию очень схоже с одним из моих файлов. Если в макросах немножко ориентируетесь то посмотрите, может разберетесь.
[vba]
Код
Sub CopyAllBook() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.CutCopyMode = False Dim wb As Workbook q = ThisWorkbook.Name
'открываем все книги в папке рабочие (там храним файлы от регионов) Dim MyName As String Dim MyPath As String Dim sPath As String ' тут вставил MyPath = "D:\Мои документы\01 - Отчеты и Анализы\01 - План-Факт\План\План по менеджерам\РЕГИОНЫ\" MyName = Dir(MyPath & "*.xlsx") Do While MyName <> "" sPath = MyPath + MyName ' тут вставил Excel.Application.Workbooks.Open sPath ' тут изменил MyName = Dir Loop
'после открытия активируем основную рабочую книгу Workbooks(q).Activate
'копируем в основную книгу данные с книг от регионов For Each wb In Application.Workbooks LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 If wb.Name <> q Then ' wb.Activate LR = wb.Worksheets(1).Cells(17, 1).End(xlUp).Row
wb.Worksheets(1).Unprotect ("000") With wb.Worksheets(1).Range("A3:O" & LR) 'во всем коде нужно поменять лишь в этой строке последний столбец в зависимости от к-во тов.групп. .Copy .PasteSpecial Paste:=xlPasteValues .Copy End With
With Selection .HorizontalAlignment = xlCenter .Font.Bold = True .Font.Italic = False .Font.Size = 10 .Font.Name = "Calibri" End With wb.Close End If Next [A1].Activate Application.CutCopyMode = True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba]
в этой строке нужно указать путь где лежат Ваши файлы (те которых 150 штук) [vba]
Код
MyPath = "D:\Мои документы\01 - Отчеты и Анализы\01 - План-Факт\План\План по менеджерам\РЕГИОНЫ\"
[/vba] Основной файл не должен быть в этой папкеDJ_Marker_MC
Один общий файл-это просто пустой файл эксель, в который скопируется один раз шапка(одна и та же во всех файлах, а под неё будут вставляться последовательно строки из остальных файлов
Один общий файл-это просто пустой файл эксель, в который скопируется один раз шапка(одна и та же во всех файлах, а под неё будут вставляться последовательно строки из остальных файловl-lisa
l-lisa, Добрый вечер. Только добрался до темы. Пробуйте: [vba]
Код
Sub CopyAllBook() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.CutCopyMode = False Dim wb As Workbook q = ThisWorkbook.Name
'открываем все книги в папке рабочие (там храним файлы от регионов) Dim MyName As String Dim MyPath As String Dim sPath As String ' тут вставил MyPath = "D:\Desktop\тест\файлы\" MyName = Dir(MyPath & "*.csv") Do While MyName <> "" sPath = MyPath + MyName ' тут вставил
'после открытия активируем основную рабочую книгу Workbooks(q).Activate
'копируем в основную книгу данные с книг от регионов For Each wb In Application.Workbooks LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 If wb.Name <> q Then wb.Activate LR = Cells(Rows.Count, 1).End(xlUp).Row
With wb.Worksheets(1).Range("A2:T" & LR) 'во всем коде нужно поменять лишь в этой строке последний столбец в зависимости от к-во тов.групп. .Copy .PasteSpecial Paste:=xlPasteValues .Copy End With
wb.Close End If Next [A1].Activate Application.CutCopyMode = True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba]
Вот тут: [vba]
Код
MyPath = "D:\Desktop\тест\файлы\"
[/vba] Укажите путь к папке с вашими csv
Файлик с макросом и кнопкой Start - в приложении.
l-lisa, Добрый вечер. Только добрался до темы. Пробуйте: [vba]
Код
Sub CopyAllBook() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.CutCopyMode = False Dim wb As Workbook q = ThisWorkbook.Name
'открываем все книги в папке рабочие (там храним файлы от регионов) Dim MyName As String Dim MyPath As String Dim sPath As String ' тут вставил MyPath = "D:\Desktop\тест\файлы\" MyName = Dir(MyPath & "*.csv") Do While MyName <> "" sPath = MyPath + MyName ' тут вставил
'после открытия активируем основную рабочую книгу Workbooks(q).Activate
'копируем в основную книгу данные с книг от регионов For Each wb In Application.Workbooks LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 If wb.Name <> q Then wb.Activate LR = Cells(Rows.Count, 1).End(xlUp).Row
With wb.Worksheets(1).Range("A2:T" & LR) 'во всем коде нужно поменять лишь в этой строке последний столбец в зависимости от к-во тов.групп. .Copy .PasteSpecial Paste:=xlPasteValues .Copy End With