最初の列が空白でない（データ量が変化する）場合にのみ、別のシートの最初の空白行にデータをコピーする

Question

「データ入力」シートから最初の空白にデータをコピーするボタンを押したい別のシート "データベース"の行。

ただし、最初の列が空白の場合は、その行のデータをコピーしないようにします。また、「データ入力」シートには4行のデータが含まれることがありますが、時には5,6,7または8があります。

私は以下のスクリーンショットを添付しました。

これまで使用していたコードではエラーは発生していませんが、何も起きていないようです。

Private Sub CommandButton1_Click() 

    Dim cl As Range  
    For Each cl In Sheet2.Range("A8:A23") 

     If Not IsEmpty(ActiveCell.Value) Then 

      Range("A" & ActiveCell.Row & ":R" & ActiveCell.Row).Select 
      Selection.Copy 
      Sheets("Database").Select 
      ActiveCell.End(xlDown).Offset(1, 0).Select 
      ActiveSheet.Paste 

     End If  
    Next cl 
End Sub 

Answer 1

あなたの現在のコードは常にActiveCellを参照している（これは、最初の繰り返し[それが今までそこまで得た場合]、「データベース」シート上のセルがあるの後！）、シート2の範囲A8：A23の細胞ではない。

リファクタリング、コードは次のようになります。

Private Sub CommandButton1_Click() 
    Dim cl As Range 

    For Each cl In Sheet2.Range("A8:A23") 
     If Not IsEmpty(cl.Value) Then 
      With Worksheets("Database") ' to make it easier to refer to the sheet 
       'Find last cell in column A, 
       ' go to the row below, 
       ' extend the range to be 18 columns wide, 
       ' set values to be values on Sheet2 
       .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 18).Value = cl.Resize(1, 18).Value 
      End With 
     End If 
    Next 
End Sub 

Answer 2

私はこのような単純な何かをしたいです。これは他の方法ほど効率的ではないかもしれませんが、それはあなたが望むようにするべきです。また、範囲はハードコードされず、データの行数が変更されると変更されます。

Dim lastRowDataEntry As Integer 
Dim lastRowDatabase As Integer 
Dim a As Integer 

'Find the last row of data in each sheet 
lastRowDataEntry = Sheets("Data Entry").Range("B" & Rows.Count).End(xlUp).Offset(0).Row 


For a = 8 To lastRowDataEntry 
    If IsEmplty(Sheets("Data Entry").Cells(a, "A").Value) = True Then GoTo ReadyForNexta 
    Row(a).Select 
    Selection.Copy 
    lastRowDataBase = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(0).Row 
    Sheets("Database").Cells(lastRowDatabase, "A").Select 
    ActiveSheet.Paste 

ReadyForNexta: 

Next a