Страницы: 1
RSS
Перенос данных как значения из нескольких книг в новую книгу на один лист
 
У меня есть несколько одинаковых файлов с одинаковыми шапками в таблицах. В таблицах некоторые ячейки заполняются по формуле. Мне необходимо объединить данные в новом файле на одном листе. Информация должна переноситься как значения.
Кто может помогите пжлс. Файл прилагаю. в нем есть макрос, но он переносить с формулами, а мне необходимы значения. Как переписать макрос, чтобы скопированные диапазоны переносились как значения.
 
И Вам здравствуйте. Попробуйте так:

Код
Sub St()
'Код рассчитан на то, что вид исходных таблиц сверху
'и снизу меняться не будет. Т.е. жёстко прописано количество
'дополнительных строк сверху и снизу.

Const fldr = "C:\Users\ната\Desktop\макрос\"  ' Путь к папке с файлами, можно добавить
                            ' стандартный диалог выбора папки или диалог
                            ' выбора самих файлов для обработки
                            
Dim strFile As String, wb As Workbook, wsSum As Workbook
 
Application.ScreenUpdating = False  'нет мелькания на экране
Set wsSum = ThisWorkbook
strFile = Dir(fldr & "*.xlsx")
Do While strFile <> ""          'Цикл по файлам

Set wb = Workbooks.Open(fldr & strFile, ReadOnly:=True)
    
With wsSum.Sheets(1)
    iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
    .Cells(iLastRow, 1).Value = Now()
    Set tbl = wb.Sheets(1).Range("A7").CurrentRegion ' определяет именно таблицу
    tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Copy
    .Range(.Cells(iLastRow, 2), .Cells(iLastRow, 2)).PasteSpecial -4163
    'сдвиг таблицы на 4 строки ниже и затем низ на 5 строк выше


End With
      
 With wsSum.Sheets(2)
    iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
    .Cells(iLastRow, 1).Value = Now()
    Set tbl = wb.Sheets(1).Range("A1").CurrentRegion ' определяет именно таблицу
    tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Copy
    .Range(.Cells(iLastRow, 2), .Cells(iLastRow, 2)).PasteSpecial -4163
    'сдвиг таблицы на 4 строки ниже и затем низ на 5 строк выше
   
End With
      
wb.Close False
strFile = Dir
Loop

Application.ScreenUpdating = True
End Sub
Учимся сами и помогаем другим...
 
Спасибо огромное, вроде бы работает. Вы меня очень выручили.
Скажите пжлс, а как можно самому научиться писать макросы. Я формулы писать умею, а вот макросы для меня почти темный лес. Как построить процес изучения?
И еще раз спасибо!!!!!!!!!!!
Изменено: Наиа - 08.07.2016 19:37:05
 
Наиа, посмотрите на своё последнее сообщение - зачем там цитата? На чём хотели сделать акцент? Запомните: кнопка цитирования не для ответа!
 
Начните например здесь
Хотя в интернете можно найти много ресурсов а-ля VBA для чайников.
Параллельно начните сидеть здесь на форуме и решать задачи других пользователей (можно для себя, а можно и делится решением). Так Вы на практике закрепите получаемые теоретические знания.
В любом случае многое зависит от личного желания изучать VBA.
Учимся сами и помогаем другим...
 
Цитата
ber$erk написал: начните сидеть здесь на форуме и решать задачи других пользователей
Очень завлекательно, но потребуется очень много времени.
На мой взгляд...
Выбрать одну, самую простую, из своих задач.
Обратиться за помощью по написанию макроса на ветке "Работа" с условием - подробный комментарий в тексте макроса.
А потом - разбираться с алгоритмом, привлекая Интернет. :)
 
Поверьте, без практики, Вы забудете разобранный алгоритм через месяц :-)
Учимся сами и помогаем другим...
 
Цитата
ber$erk написал: Вы забудете разобранный алгоритм через месяц :-)
Кто-то не согласен?!  
Вопрос ведь был не от школьника/студента. :D
Страницы: 1
Читают тему (гостей: 1)
Наверх