Скопировать ячейки A2:B5 в свободное место области печати столько раз сколько указано в другой ячейке

@latrodectus · Регистрация: 21.11.2019

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

Скопировать ячейки A2:B5 в свободное место области печати столько раз сколько указано в другой ячейке. В Примере вроде постарался все объяснить.
Печатать нужно много и в ручную получается много ошибок.
Постараюсь объяснить что должно быть на выходе. Есть клеевая бумага на подложке, бумага надрезана на 40 частей, 4 столбца и 10 строк.
Размер ячеек строго установлен и выверялся очень долго опытным путем и нужно чтобы скопированные ячейки вставлялись по четыре в стоку и переходили на следующую.
Как то так, пожалуйста помогите, а то уволят

@pashulka · 21.11.2019, 10:51

latrodectus, Можно попробовать что-то вроде этого :

Visual Basic

Private Sub Test2()
    Dim r As Range, i1&, i2&, rw&, cl&: rw = 20: cl = 1
    Set r = Range("E1").CurrentRegion
    
    Application.ScreenUpdating = False
    Cells(rw, "A").CurrentRegion.Clear
    For i1 = 2 To r.Rows.Count
        Range("C4") = r(i1, 1)
        For i2 = 1 To r(i1, 2)
            Range("B2:C5").Copy Cells(rw, cl)
            If cl = 7 Then
               cl = 1: rw = rw + 4
            Else: cl = cl + 2: End If
        Next
    Next
    Application.ScreenUpdating = True
End Sub

@latrodectus · 21.11.2019, 11:03 **[ТС]**

Спасибо огромное золотой вы человек!!!

Добавлено через 4 минуты
Всё работает отлично, если можно сделайте так чтобы при изменении артикула С2 и повторном нажатии кнопки список продолжался, а не заменялся.

@pashulka · 21.11.2019, 11:30

Вариант для второй кнопки. Или ищите артикул в этикетках или запоминайте артикул при нажатии кнопки и сравнивайте с предыдущим.

Visual Basic

Private Sub Test3()
    Dim r As Range, c As Range, i1&, i2&, rw&, cl&: rw = 20
    Set r = Range("E1").CurrentRegion
    Set c = Range(Cells(rw, "A"), Cells(Rows.Count, "H")).Find("", , xlValues)
    rw = c.Row: cl = c.Column
    
    Application.ScreenUpdating = False
    For i1 = 2 To r.Rows.Count
        Range("C4") = r(i1, 1)
        For i2 = 1 To r(i1, 2)
            Range("B2:C5").Copy Cells(rw, cl)
            If cl = 7 Then
               cl = 1: rw = rw + 4
            Else: cl = cl + 2: End If
        Next
    Next
    Application.ScreenUpdating = True
End Sub

@latrodectus · 21.11.2019, 11:43 **[ТС]**

То, что нужно!!!

@latrodectus · 22.11.2019, 06:32 **[ТС]**

Спасибо огромное ещё раз и форуму в том числе. Если кому интересно - вот что получилось, даже лучше чем я ожидал!!!

@latrodectus 0 / 0 / 0 Регистрация: 21.11.2019 Сообщений: 4
	21.11.2019, 11:03 [ТС]	3
	Спасибо огромное золотой вы человек!!! Добавлено через 4 минуты Всё работает отлично, если можно сделайте так чтобы при изменении артикула С2 и повторном нажатии кнопки список продолжался, а не заменялся. 0

@latrodectus 0 / 0 / 0 Регистрация: 21.11.2019 Сообщений: 4
	21.11.2019, 11:43 [ТС]	5
	То, что нужно!!! 0

	22.11.2019, 06:32

Скопировать ячейки A2:B5 в свободное место области печати столько раз сколько указано в другой ячейке

Решение