Скопируйте значение из той же строки в другом столбце, который соответствует диапазону непустых ячеек
Я пытаюсь получить код, который мог бы сделать две операции в одной и той же подпрограмме, если это возможно. В настоящее время у меня есть подпрограмма, которая копирует диапазон ячеек (от 1 до 19) из смежных столбцов из непустых ячеек и вставляет их в другой лист (см. Ниже код). Теперь я хочу добавить операцию, которая также может копировать значение из другого столбца (A:A), но из тех же строк предыдущего выбранного диапазона. Проблема в том, что в этом столбце А нет пустых ячеек.
Option Explicit
Sub summarize1()
Dim sIn As Worksheet, sOut As Worksheet, rIn As Range, rOut As Range
Dim inputdata() As Variant
Dim tmpArr(1 To 19) As Variant
Dim i As Long, outcount As Long
Set sIn = Sheets("Plants Data")
Set sOut = Sheets("Nutrients")
Set rIn = sIn.UsedRange
Set rOut = sOut.Range("B1:T1")
'Loads input data into an array for fast processing.
inputdata = rIn.Value
outcount = 0
'Reads data from inputdata Array and prints selected values from specified columns on Output sheet row by row.
For i = 1 To UBound(inputdata, 1)
If inputdata(i, 138) <> "" Then
outcount = outcount + 1
tmpArr(1) = inputdata(i, 138)
tmpArr(2) = inputdata(i, 139)
tmpArr(3) = inputdata(i, 140)
tmpArr(4) = inputdata(i, 141)
tmpArr(5) = inputdata(i, 142)
tmpArr(6) = inputdata(i, 143)
tmpArr(7) = inputdata(i, 144)
tmpArr(8) = inputdata(i, 145)
tmpArr(9) = inputdata(i, 146)
tmpArr(10) = inputdata(i, 147)
tmpArr(11) = inputdata(i, 148)
tmpArr(12) = inputdata(i, 149)
tmpArr(13) = inputdata(i, 150)
tmpArr(14) = inputdata(i, 151)
tmpArr(15) = inputdata(i, 152)
tmpArr(16) = inputdata(i, 153)
tmpArr(17) = inputdata(i, 154)
tmpArr(18) = inputdata(i, 155)
tmpArr(19) = inputdata(i, 156)
rOut.Offset(outcount - 1, 0).Value = tmpArr
Erase tmpArr
End If
Next i
Erase inputdata
End Sub
Есть ли кто-нибудь, кто мог бы помочь с этим?
Спасибо