копирования через макрос выборочных данных с 2 листа в 3 лист конкретную(30)строку со сдвигом вниз с 3го листа макрос выполняется,но если запускать с 1го, пытается добавить 30 строку на 1ом листе, что напрочь не надо. а как указать лист, чтоб именно в 3ем добавлял строку не знаю,)
копирования через макрос выборочных данных с 2 листа в 3 лист конкретную(30)строку со сдвигом вниз с 3го листа макрос выполняется,но если запускать с 1го, пытается добавить 30 строку на 1ом листе, что напрочь не надо. а как указать лист, чтоб именно в 3ем добавлял строку не знаю,)vitek73
Sub ВСЁ2023() 'вся статистика ' работает с любого листа Dim arr() As Variant, j As Long, rng As Range, i As Range With Worksheets(2) ' объеденяем диапазоны листа 2 для загрузки в массив Set rng = Application.Union(.[A30:G30], .[I30], .[J30]) j = 1 ' счетчик массива ' загрузка диапазона rng в массив arr For Each i In rng ReDim Preserve arr(1 To j) arr(j) = i.Value j = j + 1 Next i End With
With Worksheets(3) ' вставляем 30 строку на лист 3 .Rows(30).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'вставляем 30ю строку ' вставляем значения из массива на 3 лист в 30 строку .Cells(30, 1).Resize(1, UBound(arr, 1) - 2) = arr .Cells(30, 9) = arr(8) ' "I30" .Cells(30, 10) = arr(9) ' "J30" End With End Sub
[/vba] Если правильно Вас понял конечно.
vitek73, здравствуйте! Попробуйте код: [vba]
Код
Sub ВСЁ2023() 'вся статистика ' работает с любого листа Dim arr() As Variant, j As Long, rng As Range, i As Range With Worksheets(2) ' объеденяем диапазоны листа 2 для загрузки в массив Set rng = Application.Union(.[A30:G30], .[I30], .[J30]) j = 1 ' счетчик массива ' загрузка диапазона rng в массив arr For Each i In rng ReDim Preserve arr(1 To j) arr(j) = i.Value j = j + 1 Next i End With
With Worksheets(3) ' вставляем 30 строку на лист 3 .Rows(30).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'вставляем 30ю строку ' вставляем значения из массива на 3 лист в 30 строку .Cells(30, 1).Resize(1, UBound(arr, 1) - 2) = arr .Cells(30, 9) = arr(8) ' "I30" .Cells(30, 10) = arr(9) ' "J30" End With End Sub