Reputation: 327
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
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