Excel VBスクリプトを使用してテーブルを作成する

Question

最近、すべての質問を申し訳ありませんが、私はVBにはかなり新しくなっています。私のスクリプトでは、空のシート上で実行すると完全に動作します。しかし、私はそれを実行して、同じ値を持つテーブルを生成しようとすると、すべての値の間に大きなスペースが入ります。スクリプト自体に入れることを忘れていることはありますか？

コード

For Each i In ddg 

     Unit = "Unit #" & i 

     LastRow = Sheets("Test").Range("A50000").End(xlUp).Row + 1 

     Sheets(Unit).Range("A2:A100").Copy Destination:=Sheets("Test").Range("A" & LastRow) 

     Sheets(Unit).Range("B2:B100").Copy Destination:=Sheets("Test").Range("D" & LastRow) 

     Sheets(Unit).Range("C2:C100").Copy Destination:=Sheets("Test").Range("E" & LastRow) 

     Sheets(Unit).Range("D2:D100").Copy Destination:=Sheets("Test").Range("F" & LastRow) 

     Sheets(Unit).Range("E2:E100").Copy Destination:=Sheets("Test").Range("G" & LastRow) 

     Sheets(Unit).Range("F2:F100").Copy Destination:=Sheets("Test").Range("L" & LastRow) 


    Next i 

Answer 1

あなたが値をコピーしようとしているように見え、特定の基準に基づいて、別のシートに1シートを形成。あなたのコードは奇妙に思える。あなたはシートから完全に資格を取得する必要があることをご存知でしょうか。このように試してみてください。

Sub Copy_If_Criteria_Met() 
    Dim xRg As Range 
    Dim xCell As Range 
    Dim I As Long 
    Dim J As Long 
    I = Worksheets("Sheet1").UsedRange.Rows.Count 
    J = Worksheets("Sheet2").UsedRange.Rows.Count 
    If J = 1 Then 
     If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0 
    End If 
    Set xRg = Worksheets("Sheet1").Range("A1:A" & I) 
    On Error Resume Next 
    Application.ScreenUpdating = False 
    For Each xCell In xRg 
     If CStr(xCell.Value) = "X" Then 
      xCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) 
      xCell.EntireRow.Delete 
      J = J + 1 
     End If 
    Next 
    Application.ScreenUpdating = True 
End Sub