空でないセルをすべてコピーし、別のワークシートの次の使用可能なセルに貼り付ける方法

Question

シート1の「配送用のドケット」から値をコピーしたい。私がコピーしたいセルは、A18：A160の空でないすべてのセルからのものになります。

次のステップでは、空でないセルの値をSheet2 "Shipping register"に貼り付けます。この値はセルA2から始まり、セルが空でない場合は下に移動します。私は以前に友人に私にこれを作ってもらうように頼んだのですが、ループと+1機能を追加することを覚えています。なぜならセルには次のセルに移動しなければならない値があるからです。

Answer 1

これを試してみてください：

Private Sub copyNon_EmptyCells() 
    Dim ws1 As Worksheet, ws2 As Worksheet 
    Dim vals() As String, valCount As Integer 
    Dim lastRow As Integer, r As Integer 

    Set ws1 = Sheets(1) 
    Set ws2 = Sheets(2) 

    ' set last row variable 
    lastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row 

    For r = 18 To lastRow 
     If (Not ws1.Cells(r, 1) = vbNullString) Then 
      ReDim Preserve vals(valCount) 
      vals(valCount) = ws1.Cells(r, 1) 
      valCount = valCount + 1 
     End If 
    Next r 

    For r = 0 To valCount - 1 
     ws2.Cells(r + 2, 2) = vals(r) 
    Next r 

End Sub