Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сбор данных с разных книг с сохранением истории
 
#1
11.02.2020 12:10:58
Добрый день. В макросах особо не сильна (вообще не сильна)).
Нашла подобные темы, то что смогла подредактировала под себя.
Но, не учла нюанс что копируется только первая строка (из-за указанных ячеек).
Суть:
Необходимо собрать данные с разных книг на один сводный лист "Оплаты" только с тех столбцов, которые указала в макросе.
Как собрать книги в один файл - нашла. Консолидация вроде тоже идет, но только по второй строке каждого листа.
Теперь необходимо чтоб данные копировались не только с тех ячеек, которые я указала, а со всех строк и листов... (кол-во строк всегда меняются, но очередность столбцов постоянная)
Очень надеюсь на Вашу помощь!  
 
 
 
#2
11.02.2020 12:50:33
В макросе Main
Код
a = Array("D", "E", "F", "H", "I", "K", "L", "M", "N", "O", "P")

   For j = LBound(a) To UBound(a)
      iLR = ws.Cells(ws.Rows.Count, a(j)).End(xlUp).Row
      ws.Range(ws.Cells(2, a(j)), ws.Cells(iLR, a(j))).Copy sh.Cells(i, j + 2)
  Next
 
 
 
#3
11.02.2020 14:06:24
Вставила так, не работает(
Код
Sub Main()
    Dim ws As Worksheet, sh As Worksheet, i As Long, j As Long, a()
    Application.ScreenUpdating = False: Set sh = Sheets("Îïëàòû")
    a = Array("D", "E", "F", "H", "I", "K", "L", "M", "N", "O", "P")
  
   For j = LBound(a) To UBound(a)
      iLR = ws.Cells(ws.Rows.Count, a(j)).End(xlUp).Row
      ws.Range(ws.Cells(2, a(j)), ws.Cells(iLR, a(j))).Copy sh.Cells(i, j + 2)
  Next
End Sub
 
 
 
#4
11.02.2020 14:08:02
Miko,
Я вам написал какие строки надо заменить, но остальное надо оставить
Код
Sub Main()
    Dim ws As Worksheet, sh As Worksheet, i As Long, j As Long, a()
    Application.ScreenUpdating = False: Set sh = Sheets("Оплаты")
    'a = Array("D2", "E2", "F2", "H2", "I2", "K2", "L2", "M2", "N2", _
    '    "O2", "P2")
    a = Array("D", "E", "F", "H", "I", "K", "L", "M", "N", "O", "P")
    For Each ws In Sheets
        If ws.Name <> sh.Name Then
            i = sh.Cells(Rows.Count, 4).End(xlUp).Row + 1: If i < 4 Then i = 4
            For j = LBound(a) To UBound(a)
              iLR = ws.Cells(ws.Rows.Count, a(j)).End(xlUp).Row
              ws.Range(ws.Cells(2, a(j)), ws.Cells(iLR, a(j))).Copy sh.Cells(i, j + 2)
              'sh.Cells(i, j + 2) = ws.Range(a(j))
            Next
        End If
    Next
End Sub
Изменено: Kuzmich - 11.02.2020 14:09:58
 
 
 
#5
11.02.2020 14:58:30
Все работает, спасибо)
 
 
 
#6
28.05.2021 08:59:52
Добрый день, снова я со своим макросом, помогите пжл.

Нужно поправить 2-й макрос, так чтобы собирались данные (с листов) только те что в таблице, все что ниже таблицы (итог и текст) не нужно собирать.
Кол-во строк всегда и на каждом листе разное.
Я это понимаю так: типа не собирать данные с листа начиная с пустой строки в столбце "А".
Но как это написать не знаю((((

Очень благодарна Вам за постоянную помощь!  
 
 
 
#7
28.05.2021 11:26:26
попробуйте вот так:
Код
Public Function getRowsCount(ByRef sh As Worksheet) As Integer
 Dim rF As Range
 Set rF = sh.UsedRange.Find("*", , xlValues, xlWhole, , xlPrevious)
 If Not rF Is Nothing Then
   getRowsCount = rF.Row
 Else
   getRowsCount = 1
 End If
End Function


Sub loadVals()
    Dim wb As Workbook
    Dim wsWrk As Worksheet
    Dim ws As Worksheet
    Dim iRow As Long
    Dim iRowCurrent As Long
 
    Set wb = ActiveWorkbook
    Set ws = ActiveSheet
    iRow = getRowsCount(ws)
    iRowCurrent = 3
    
    Application.ScreenUpdating = False
    ws.Range("A3:S" & iRow).ClearContents
    For Each wsWrk In wb.Sheets
        If wsWrk.Name <> ws.Name Then
          iRow = wsWrk.Cells(Rows.Count, 4).End(xlUp).Row
          If iRow >= 3 Then
            wsWrk.Range("A3:S" & iRow).Copy _
              Destination:=ws.Range("B" & iRowCurrent)
            
            iRowCurrent = iRowCurrent + iRow - 2
          End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub
правда этот макрос собирает данные с листов активной книги, но это можно доделать
Изменено: Alice Sadman - 28.05.2021 11:26:52
 
 
 
#8
28.05.2021 11:34:03
Alice Sadman, как-то у меня не получается...
я если честно вообще макросы писать не умею(  :oops:  
Изменено: Miko - 28.05.2021 11:34:46 (не дописала)
 
 
 
#9
28.05.2021 11:56:35
откройте файл и нажмите на кнопку "Консолидация данных"
 
 
 
#10
28.05.2021 12:29:11
Miko, А дубль темы зачем?
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=140779&TITLE_SEO=140779-makros-konsolidatsii-dannykh-v-odnom-svodnom-liste&logout_butt=%D0%92%D1%8B%D0%B9%D1%82%D0%B8

дубль-тема закрыта и будет удалена [МОДЕРАТОР]

Зачем переносить данные в цикле по столбцам? Почему нельзя сразу диапазоном?
Код
Sub Консолидация_()
    Dim ws As Worksheet, sh As Worksheet, i As Long
    Application.ScreenUpdating = False: Set sh = Sheets("Итого")
    For Each ws In Sheets
      If ws.Name <> sh.Name Then
         i = sh.Cells(Rows.Count, 3).End(xlUp).Row + 1: If i < 3 Then i = 3
         iLR = ws.Cells(1, "A").End(xlDown).Row
         ws.Range(ws.Cells(3, "A"), ws.Cells(iLR, "R")).Copy sh.Cells(i, "B")
      End If
    Next
End Sub
 
 
 
#11
28.05.2021 13:53:59
Alice Sadman, спасибо большое!
 
 
 
#12
28.05.2021 13:57:08
доделаете сами копирование из разных книг?
 
 
 
Страницы: 1
Наверх