VBAを使用して新しいワークシートにコピーされた後に空の行を削除する

Question

Excel用のVBAスクリプトを作成し、A列に特定のエントリ（この場合は2016）が含まれているかどうかを確認し、新しいワークシート。

唯一の問題は、元のワークシートとまったく同じ位置に行をコピーしていることです。そのため、私はその間に空の行を取得します。マクロをコピーした直後にそれらの空の行を削除するか、または新しいワークシートに行を1つずつコピーするかのどちらかにしたいと思います。

Sub CopyRow() 

Application.ScreenUpdating = False 

Dim x As Long 
Dim MaxRowList As Long 
Dim S As String 
Dim wsSource As Worksheet 
Dim wsTarget As Worksheet 


Set wsSource = ThisWorkbook.Worksheets("Tab 1") 
Set wsTarget = ThisWorkbook.Worksheets("Tab 2") 

aCol = 1 
MaxRowList = wsSource.Cells(rows.Count, aCol).End(xlUp).Row 

For x = 2 To MaxRowList 
    If InStr(1, wsSource.Cells(x, 1), "2016") Then 
    wsTarget.rows(x).Value = wsSource.rows(x).Value 
    End If 
Next 

Application.ScreenUpdating = True 

End Sub 

助けてください。前もって感謝します。あなたはこのような先の行のための変数を設定することができます

Answer 1

：

Sub CopyRow() 

Application.ScreenUpdating = False 

Dim x As Long 
Dim MaxRowList As Long 
Dim S As String 
Dim wsSource As Worksheet 
Dim wsTarget As Worksheet 


Set wsSource = ThisWorkbook.Worksheets("Tab 1") 
Set wsTarget = ThisWorkbook.Worksheets("Tab 2") 

aCol = 1 
MaxRowList = wsSource.Cells(rows.Count, aCol).End(xlUp).Row 

destiny_row = 2 
For x = 2 To MaxRowList 
    If InStr(1, wsSource.Cells(x, 1), "2016") Then 
    wsTarget.rows(destiny_row).Value = wsSource.rows(x).Value 
    destiny_row = destiny_row +1 
    End If 
Next 

Application.ScreenUpdating = True 

End Sub 

この方法は、それが先のシートの行2で、これらの値のコピーを開始しますと、もしcondition.Tellどのように私に応じて増加しますそれは

Answer 2

Sub CopyRow() 

    Application.ScreenUpdating = False 

    Dim x As Long 
    Dim MaxRowList As Long, PrintRow as Long 
    Dim S As String 
    Dim wsSource As Worksheet 
    Dim wsTarget As Worksheet 


    Set wsSource = ThisWorkbook.Worksheets("Tab 1") 
    Set wsTarget = ThisWorkbook.Worksheets("Tab 2") 

    aCol = 1 
    MaxRowList = wsSource.Cells(rows.Count, aCol).End(xlUp).Row 

    For x = 2 To MaxRowList 
     If InStr(1, wsSource.Cells(x, 1), "2016") Then 
      PrintRow = wsTarget.range("A" & wsTarget.rows.count).end(xlup).row 
      wsTarget.rows(PrintRow).Value = wsSource.rows(x).Value 
     End If 
    Next 

    Application.ScreenUpdating = True 

End Sub 

Answer 3

あなたはAutoFilterメソッドを使用することができますが、それはあなたのすべての行をForループを使用して、ちょうどあなたの「タブ2」のワークシートに全体のフィルタ処理の範囲をコピーする必要が保存されます...行きます。あなたの輸出行に対して別々の行カウンタを維持することができ

Option Explicit 

Sub CopyRow() 

Application.ScreenUpdating = False 

Dim x As Long 
Dim MaxRowList As Long 
Dim MaxCol As Long 

Dim S As String 
Dim aCol As Long 
Dim wsSource As Worksheet 
Dim wsTarget As Worksheet 
Dim SourceRng As Range 
Dim VisRng As Range 
Set wsSource = ThisWorkbook.Worksheets("Tab 1") 
Set wsTarget = ThisWorkbook.Worksheets("Tab 2") 

aCol = 1 

With wsSource 
    MaxRowList = .Cells(.Rows.Count, aCol).End(xlUp).Row ' find last row 
    MaxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column ' find last column 

    Set SourceRng = .Range(.Cells(1, 1), .Cells(MaxRowList, MaxCol)) ' set source range to actually occupied range 

    .Range("A1").AutoFilter ' use AutoFilter method 
    SourceRng.AutoFilter Field:=1, Criteria1:="2016" 

    Set VisRng = SourceRng.SpecialCells(xlCellTypeVisible) ' set range to filterred range 

    VisRng.Copy ' copy entire visible range 
    wsTarget.Range("A2").PasteSpecial xlPasteValues ' past with 1 line 
End With 

Application.ScreenUpdating = True 

End Sub