Копирование и вставка только ячеек со значениями с использованием VBA

Question

Как я могу обновить свой код, чтобы копировать только ячейки с данными.Он ищет и выбирает столбцы с заголовками «инструкция» или «направление».Так как он выбирает весь столбец, я получаю ошибку несоответствия размера.Я хочу, чтобы он только копировал непустые ячейки в исходном листе и вставлял его ниже следующей пустой ячейки в столбце b нового листа.Это то, что у меня есть, но я еще не проверял, и я знаю, что синтаксис где-то неверен

Sub CopyData(ORIGINAL As Worksheet, newWS As Worksheet)
Dim Title As Range
Dim LastRow As Long
Dim dest As Range

With ORIGINAL.Rows(1)
Set Title = .Find("Instruction")
If Title Is Nothing Then Set Title = .Find("Direction")
End With

'Get last used row, and add 1 (for next one)
LastRow = newWS.Cells(Rows.Count, 1).End(xlUp).Row + 1

If Not Title Is Nothing Then
    Title.EntireColumn.RemoveDuplicates Columns:=1, Header:=xlNo
    Set Title = Title.EntireColumn.SpecialCells(2)
    Set dest = newWS.Cells(LastRow, 1).End(xlUp).Offset(0, 1)
    Title.copy dest
    newWS.Columns.AutoFit
Else
    MsgBox "Error"
End If

End Sub

Answer 1

Это может помочь вам.Скажем, у нас есть:

, и наша цель:

• найти столбец Instruction
• копировать только ячейки, содержащие данные в этом столбце
• вставить в столбец F ниже любых существующих данных в этом столбце

Код:

Sub Soso()
    Dim rToCopy As Range, rDest As Range

    Set rToCopy = Rows("1:1").Cells.Find(What:="Instruction")
    Set rToCopy = rToCopy.EntireColumn.SpecialCells(2)

    Set rDest = Cells(Rows.Count, "F").End(xlUp).Offset(1, 0)
    rToCopy.Copy rDest
End Sub

и после:

ПРИМЕЧАНИЕ:

• пустых ячеек нетбыло скопировано.
• мой код предназначен для констант, а не формул

Если у вас есть формулы в столбце Instruction, используйте SpecialCells(-4123)