CODEWITHSUNDEEP
vbaexcelrows
D. Todor
D. Todor

Reputation: 157

Deleting empty rows in Excel after they have been copied into new worksheet using VBA

I have successfully written a VBA script for Excel which checks if column A contains a specific entry (in this case: 2016) and then copies the entire row into a new worksheet.

The only problem is that it is copying the rows into the exact same position as in the original worksheet. Because of that I get empty rows in between. I would like the macro to either delete those empty rows right after copying them or to copy the rows one after another into the new worksheet.

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

Any help is appreciated. Thanks in advance.

Upvotes: 1

Views: 430

Answers (3)

Shai Rado
Shai Rado

Reputation: 33692

You could use the AutoFilter method, it will save you the need to use the For loop through all the rows, and just copy the entire filtered range to your "Tab 2" worksheet.

Code (explanation inside comments)

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

Upvotes: 1

jsanchezs
jsanchezs

Reputation: 2070

You can set a variable for the destination row like this :

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

This way, it will start copying those values in destination sheet row 2 and will be increasing according to the if condition.Tell me how it goes...

Upvotes: 1

Preston
Preston

Reputation: 8187

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

Upvotes: 0

Related Questions