FrenchConnections
FrenchConnections

Reputation: 391

Copy all cells with values from a range of columns into one single column

I am a beginner with VBA, and I've been working on my first large-scale project. I have a Spreadsheet that compares multiple sets of data, and spits out values if there are any errors. My values are in range T4:X4 and I would like all of the values to be displayed sequentially in the range Z4:Z, with no blanks. One of the problems is all of the blank cells actually have formulas in them that just evaluate to " ". I don't want to copy those.

Here is the code I have written thus far:

Sub Generate_ReportVSP1()

Dim rSource As Range
Dim TargetRange As Range

Dim i As Integer
Dim j As Integer

Dim LastRowCarrier As Long
Dim LastRowConsole As Long
Dim ws2 As Worksheet

Set ws2 = Sheets("Sheet2")

LastRowCarrier = ws2.Cells(Rows.Count, "X").End(xlUp).Row
LastRowConsole = ws2.Cells(Rows.Count, "S").End(xlUp).Row
LastRowReport = ws2.Cells(Rows.Count, "AA").End(xlUp).Row

 Set rSource = Application.Union(Range("T4:T" & LastRowConsole),    Range("U4:U" & LastRowConsole), Range("V4:V" & LastRowConsole), Range("W4:W" & LastRowConsole), Range("X4:X" & LastRowCarrier))

 Application.Calculation = xlCalculationManual

For j = 4 To LastRowCarrier
    If Cells(j, 20).Value <> " " Then
    Cells(j, 20).Copy
    Cells(j, 26).PasteSpecial Paste:=xlPasteValues
End If
Next j

Application.Calculation = xlCalculationAutomatic

With Sheets("Sheet2")
Range("AA4" & LastRowReport).SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp

End With

End Sub

Upvotes: 0

Views: 1949

Answers (1)

Gary&#39;s Student
Gary&#39;s Student

Reputation: 96753

Consider:

Sub ReOrganize()
    Dim K As Long, ar
    K = 1
    For Each ar In Array("T", "U", "V", "W", "X")
        For i = 1 To 4
            If Cells(i, ar).Value <> "" Then
                Cells(K, "Z").Value = Cells(i, ar).Value
                K = K + 1
            End If
        Next i
    Next ar
End Sub

For example:

enter image description here

Upvotes: 2

Related Questions