Вставить макросом диапазон без видимых пустых ячеек

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Вставить макросом диапазон без видимых пустых ячеек (Макросы/Sub)

Фомулист

Дата: Пятница, 22.01.2021, 18:08 | Сообщение № 1

Группа: Проверенные

Ранг: Обитатель

Сообщений: 398

Репутация: 9 ±

Замечаний: 80% ±

Excel 2003

Здравствуйте снова, народ.
В приложенном файле мне нужно вставить ячейки столбца U, в которых видны цифры (остальные содержат пустую строку - спецвставка результата формулы) в столбец N, начиная с 448 строки. Сам я написал код:
[vba]

Код

Sub Копипаст()
Dim Cell As Range, r As Range
Set r = Range("U4" & ":" & "U104")
With ActiveWorkbook
For Each Cell In r
  If Not Intersect(Cell, r) Is Nothing And Cell.Value <> "" Then
     Cell.Copy
     For i = 448 To 548
      With Range("N" & i)
       ActiveSheet.Paste
       i = i + 1
      End With
     Next i
  End If
Next Cell
End With
End Sub

[/vba]
Но он:
1) перебирает все значения, скопированные из столбца U, в одной ячейке и оставляет в ней последнее значение.
2) Несмотря на то, что в макросе указано With Range("N" & i), скопированные значения вставляются в выделенную на момент запуска кода ячейку.
Помогите исправить код, пожалуйста.

К сообщению приложен файл: 6690433.xls (31.5 Kb)

Терпение и труд всё перетрут!

Ответить

_Igor_61

Дата: Пятница, 22.01.2021, 22:27 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 504

Репутация: 90 ±

Замечаний: 0% ±

Excel 2007

Фомулист, а в прошлой теме это же? Замените [vba]

Код

Range("H3:H" & Cells(Rows.Count, 8).End(xlUp).Row)

[/vba] на [vba]

Код

Range("U4:U" & Cells(Rows.Count, 21).End(xlUp).Row)

[/vba] и "G3" на "N448". Или не то нужно? В прошлой теме не отписались, получилось или нет

К сообщению приложен файл: 7031771.xls (37.0 Kb)

Ответить

Kuzmich

Дата: Пятница, 22.01.2021, 22:36 | Сообщение № 3

Группа: Проверенные

Ранг: Ветеран

Сообщений: 713

Репутация: 157 ±

Замечаний: 0% ±

Excel 2003

[vba]

Код

Sub Копипаст_1()
Dim iLR As Long
Dim Cell As Range
     iLR = 448
     Columns("N").ClearContents
   For Each Cell In Range("U4:U104")
     If Cell <> "" Then
       Cell.Copy
       Range("N" & iLR).PasteSpecial xlPasteValues
       iLR = iLR + 1
     End If
   Next
End Sub

[/vba]