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

Спасибо заранее!
 
Добрый день.
Код
Sub CopyRangeNtimes()
    Dim lastRow&, i&, Counter%, rngTemp As Range
    Application.ScreenUpdating = False
    If Range("E4").Value <> "" And IsNumeric(Range("E4").Value) Then
        Counter = Abs(Range("E4").Value)
    Else
        MsgBox "В ячейе ""E4"" не указано количество копий", vbInformation
        End
    End If
    Set rngTemp = Range("B2").CurrentRegion
    rngTemp.Copy Range("G1")
    Set rngTemp = Range(rngTemp.Cells(2, 1), rngTemp.Cells(2, 1).End(xlDown).End(xlToRight))
    If Counter > 1 Then
        For i = 2 To Counter
            lastRow = Cells(Cells.Rows.Count, "G").End(xlUp).Row
            rngTemp.Copy Cells(lastRow + 1, "G")
        Next i
    End If
End Sub

___
Возможное название темы: "VBA. Копирование таблицы заданное количество раз"
Изменено: DANIKOLA - 09.02.2024 16:57:15
 
Цитата
написал:
Добрый день.КодSub CopyRangeNtimes()
   Dim lastRow&, i&, Counter%, rngTemp As Range
   Application.ScreenUpdating = False
   If Range("E4").Value <> "" And IsNumeric(Range("E4").Value) Then
       Counter = Abs(Range("E4").Value)
   Else
       MsgBox "В ячейе ""E4"" не указано количество копий", vbInformation
       End
   End If
   Set rngTemp = Range("B2").CurrentRegion
   rngTemp.Copy Range("G1")
   Set rngTemp = Range(rngTemp.Cells(2, 1), rngTemp.Cells(2, 1).End(xlDown).End(xlToRight))
   If Counter > 1 Then
       For i = 2 To Counter
           lastRow = Cells(Cells.Rows.Count, "G").End(xlUp).Row
           rngTemp.Copy Cells(lastRow + 1, "G")
       Next i
   End If
End Sub
Спасибо!
Страницы: 1
Наверх