sample_00.vba

Sub Pack()
    Dim a() As String ' 文字列を入れる配列
    Dim index As Integer  ' 有効なセルの個数
    
    index = 0
    For Each c In ThisWorkbook.Sheets("Source").Range("B1:B10")
        If c <> "" Then
            ReDim Preserve a(index) ' 必要な配列を確保する
            a(index) = c
            index = index + 1
        End If
    Next c
    
    ThisWorkbook.Sheets("Target").Range(Cells(1, 1), Cells(1, index)) = a

End Sub