Adrian Gornall
Adrian Gornall

Reputation: 327

Copy and paste array of data to remove blanks rows of data

I'm currently trying to develop a script which moves from one sheet to another and copies the data from one table to another. The problem I’m having is the source table doesn't have all rows populated with data and the destination needs to be presented with the data collapsed without blank rows. The source data can vary from 100 to 1000 rows each time the script is used.

I have tried a number of solutions, remove blanks, remove duplicates, and these don't work.

Here is the script I have been using.

Sub AS1055datacrunch()
    Sheets("Data Extract").Select
    Range("BI3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("AS 1055 Table").Select
    Range("C8").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True
    Call RemoveGaps
End Sub

Sub RemoveGaps()
    With Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        .value = .value
        .RemoveDuplicates Columns:=1, Header:=xlNo
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
        On Error GoTo 0
    End With
End Sub 

I'm wondering is there any way I can have the data copied into an array of some kind and then pasted in a consolidated table of data.

Upvotes: 0

Views: 2640

Answers (1)

sagar
sagar

Reputation: 26

this should work, it deletes blank rows

Sub RemoveGaps()
    Dim ro As Integer, first As Integer, last As Integer
    first = Selection.Row
    last = first + Selection.Rows.Count - 1
    For ro = last To first Step -1
        ''checking for blank columns in column c to e
        If Application.WorksheetFunction.CountA(Range("C" & ro & ":" & "E" & ro)) = 0 Then
            Range(ro & ":" & ro).Rows.Delete Shift:=xlUp
        End If
    Next ro
End Sub

Upvotes: 1

Related Questions