Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Перенос заполненных ячеек
 
#1
18.03.2020 20:52:13
Уважаемые гуру Excel. Очень прошу помощи. Помогите решить задачу макросами. я заполняю вкладку "Игрушки Насти", потом вкладку "Игрушки Лизы", но не все позиции. Задача перенести во вкладку "Общая" сначала, заполненные кол-вом строки из вкладки "Игрушки Насти", потом из вкладки "Игрушки Лизы". Может еще вкладки будут.
Заранее благодарен Вам всем. Виктор
 
 
 
#2
18.03.2020 21:36:28
Цитата
Помогите решить задачу макросами
Код
'запускать при активном листе "общая"
Sub Sbor()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim Sh_O As Worksheet
Dim Sht As Worksheet
  Set Sh_O = ThisWorkbook.Worksheets("общая")
  Range("C11:F21").ClearContents
 For Each Sht In Worksheets
   Select Case Sht.Name
     Case "Игрушки Насти", "Игрушки Лизы"
       With Sht
         iLR = .Cells(.Rows.Count, "B").End(xlUp).Row
         If iLR > 3 Then
           For i = 3 To iLR
            If Not IsEmpty(.Cells(i, "C")) Then
              iLastRow = Sh_O.Cells(Sh_O.Rows.Count, "C").End(xlUp).Row + 1
             .Range(.Cells(i, "B"), .Cells(i, "E")).Copy Sh_O.Cells(iLastRow, "C")
            End If
           Next
         End If
       End With
     End Select
 Next
End Sub
 
 
 
#3
18.03.2020 21:38:00
Если без особых заморочек и начальные строки/столбцы постоянны, то можно так:
Код
Sub Toys()
    
    Dim wsToy As Worksheet      'Лист с игрушками
    Dim wsMain As Worksheet     'Лист с главной таблицей
    
    Dim i As Long               'Начальная строка в таблице игрушек
    Dim j As Long               'Начальная строка в общей таблице
    
    Set wsMain = ThisWorkbook.Worksheets("общая")
    
    j = 11
    
    'Очистка общей таблицы
    With wsMain
        .Range(.Rows(j + 1), .Rows(.Rows.Count)).Delete
    End With
    
    For Each wsToy In ThisWorkbook.Worksheets
        If wsToy.Name <> wsMain.Name Then
            i = 3
            Do While wsToy.Cells(i - 1, 2) <> ""
                If wsToy.Cells(i, 3) > 0 Then
                    wsMain.Cells(j, 2) = j - 10
                    wsMain.Cells(j, 3) = wsToy.Cells(i, 2)
                    wsMain.Cells(j, 4) = wsToy.Cells(i, 3)
                    wsMain.Cells(j, 5) = wsToy.Cells(i, 4)
                    wsMain.Cells(j, 6) = wsToy.Cells(i, 5)
                    j = j + 1
                End If
                i = i + 1
            Loop
        End If
    Next

    With wsMain
        .Range(Cells(11, 2), Cells(11, 6)).AutoFill Destination:=.Range(Cells(11, 2), Cells((j - 1), 6)), Type:=xlFillFormats
    End With
    
End Sub
Изменено: Valo - 18.03.2020 21:39:04
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
 
 
#4
18.03.2020 21:46:36
Или так:
 
 
 
#5
18.03.2020 21:47:27
bybys, еще вариант
Код
Sub boom()
Dim i As Double
Dim sh As Worksheets
Worksheets("общая").Range("B11:F" & Worksheets("общая").Cells(Rows.Count, 3).End(xlUp).Row+1).Clear
Application.ScreenUpdating = False
For Each Wh In Worksheets
If Wh.Name <> "общая" Then
ilastrow = Wh.Cells(Rows.Count, 2).End(xlUp).Row
ilastrow2 = Worksheets("общая").Cells(Rows.Count, 3).End(xlUp).Row
    If ilastrow2 <= 1 Then
    ilastrow2 = ilastrow2
    Else
    ilastrow2 = ilastrow2 + 1
    End If
    Wh.Range("A3:e" & ilastrow).Copy Destination:=Worksheets("общая").Cells(ilastrow2, 2)
End If
Next Wh
Application.ScreenUpdating = True
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#6
18.03.2020 21:51:14
Благодарю, единственное мне нужно, чтобы переносились только те строки в которых заполнено кол-во( Это возможно?
Изменено: bybys - 18.03.2020 21:52:45
 
 
 
#7
18.03.2020 21:56:43
bybys, Sub boom()
Код
Sub boom()
Dim i As Double
Dim sh As Worksheets
Worksheets("общая").Range("B11:F" & Worksheets("общая").Cells(Rows.Count, 3).End(xlUp).Row + 1).Clear
Application.ScreenUpdating = False
For Each wh In Worksheets
If wh.Name <> "общая" Then
ilastrow = wh.Cells(Rows.Count, 2).End(xlUp).Row
ilastrow2 = Worksheets("общая").Cells(Rows.Count, 3).End(xlUp).Row
For i = 3 To ilastrow
    If wh.Cells(i, 3) > 0 Then
    If ilastrow2 <= 1 Then
    ilastrow2 = ilastrow2
    Else
    ilastrow2 = ilastrow2 + 1
    End If
    wh.Range("A" & i & ":" & "e" & i).Copy Destination:=Worksheets("общая").Cells(ilastrow2, 2)
End If

Next i
End If
Next wh
Application.ScreenUpdating = True
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#8
18.03.2020 22:03:29
Здорово!!! Я просто премного Вам благодарен, нет слов. Все работает. А если у меня еще вкладки добавятся, что мне нужно дописать будет?
 
 
 
#9
18.03.2020 22:04:35
bybys, проверьте) вообще нет, только главное что бы данные располагались одинаково.  И вкладки  - это не он, а их название Листы!
Изменено: Mershik - 18.03.2020 22:09:03
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#10
18.03.2020 22:09:02
Да уж мастерски сделано) мне бы так уметь) Данные располагались одинаково - это столбцы не добавлялись?  
 
 
 
#11
18.03.2020 22:10:31
bybys, в том числе...столбцы, так как я привязался к номерам столбцов и строкам (начало  и конец таблицы данных )..если количество копируемых данных нужно будет изменить букву ...
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#12
18.03.2020 22:13:01
Вот да, номер как бы и не нужно копировать в общую) а то все порядковые номера в таблице общая не по порядку идут(
 
 
 
#13
18.03.2020 22:16:48
bybys,попробуйте вариант, который я предлагал ранее.
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
 
 
#14
18.03.2020 22:20:12
Всем огромнейшее СПАСИБО! От меня, жены и дочерей)))  
 
 
 
#15
18.03.2020 22:20:32
bybys, написал
Цитата
единственное мне нужно, чтобы переносились только те строки в которых заполнено кол-во( Это возможно?
Видимо вы мой вариант не пробовали?
 
 
 
#16
18.03.2020 22:22:13
bybys,  
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#17
18.03.2020 22:23:38
Цитата
Kuzmich написал:
Видимо вы мой вариант не пробовали?
Я просто не знаю куда это вставлять))) Если Вас не затруднит, вставьте это код в мой файлик, пожалуйста)
 
 
 
#18
18.03.2020 22:27:17
Цитата
не знаю куда это вставлять
В стандартный модуль
 
 
 
#19
18.03.2020 22:29:04
Все эти коды работают (завтра проверю на практике),  знать бы еще чем они отличаются...) Буду себя заставлять изучать мир макросов!!! Буду тоже другим помогать!  
 
 
 
#20
18.03.2020 22:33:25
Цитата
Kuzmich написал:
В стандартный модуль
Работает! только столбцы не расширяются в зависимости от текста.  Это можно и руками расширить. И при добавлении новых вкладок не добавляются данные в таблицу на вкладке Общая. Все равно спасибо за потраченное Вами на меня время и силы!
Изменено: bybys - 18.03.2020 22:36:50
 
 
 
#21
18.03.2020 22:39:57
Цитата
только столбцы не расширяются в зависимости от текста.
Вставьте строку в конец кода перед End Sub
Код
Columns("C:F").AutoFit
 
 
 
#22
18.03.2020 22:57:22
Работает!!! А возможно ли печатать во вкладке Общая перед списком вкладки "Игрушки Насти" - так и писать "Игрушки Насте" (лучше в объединенной ячейке), а потом список и тоже самое перед списком вкладки "Игрушки Лизы" - писать "Игрушки Лизы? Или я уже совсем много попросил?) :oops:  
 
 
 
#23
18.03.2020 23:03:27
Цитата
bybys написал:
А возможно ли...
А можно СРАЗУ все свои "хотелк"и формулировать? Не по одной, а все сразу?
 
 
 
#24
18.03.2020 23:08:45
Извините! Просто хотелки приходят во время еды)  
 
 
 
#25
18.03.2020 23:19:44
А правило "один вопрос - одна тема"?
А название темы кто теперь предложит?
 
 
 
#26
18.03.2020 23:26:23
Я же попросил извинения! Но это же одна таблица и одна тема. Хорошо, больше вопросов по этой теме не будет! Будут вопросы, создам новую тему. Благодарю Вас за создание и поддержание такого чудесного сайта! Дай Вам Бог всем здоровья!
 
 
 
#27
18.03.2020 23:55:14
Добавьте строки
Код
       With Sht
         iLastRow = Sh_O.Cells(Sh_O.Rows.Count, "C").End(xlUp).Row + 1
         Cells(iLastRow, "C") = Sht.Name
         Cells(iLastRow, "C").Font.Size = 12
         Cells(iLastRow, "C").Font.Bold = True
 
 
 
Страницы: 1
Наверх