Home Ask Login Register

Developers Planet

Your answer is one click away!

Eileen Lorant February 2016

Copy multiple Range from Sheet1 based on a conditionand paste it in Alongside in Sheet2

I have an issue with my vba code in excel. I am trying to get excel automatically copy the contents of multiple ranges (B, C, D, F, G) from sheet1 based on a condition to sheet2 as side by side. example how this will look like:

Image Example

this is my code which only copy range B to D :

Sub CopyButton()
Dim cell As Range
Dim lastRow As Long, i As Long
lastRow = Range("D" & Rows.Count).End(xlUp).Row
i = 5
For Each cell In Sheets(1).Range("D2:D" & lastRow)
If cell.Value > 0 Then
r=cell.row
range("B" & r & ":D" & r).Copy Sheets(2).Cells(i, 1)
i = i + 1
End If
Next
End Sub

Any help would be appreciated.

Answers


Jeeped February 2016

This can easily be accomplished with an AutoFilter method to isolate the rows and a Union method of the Range.SpecialCells using the xlCellTypeVisible xlCellType Enumeration option.

Sub xferBCDFG()
    With Worksheets("sheet1")
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            .AutoFilter field:=4, Criteria1:="<>0"
            With Union(.Range("B:D"), .Range("F:G")).SpecialCells(xlCellTypeVisible)
                .Copy Destination:=Worksheets("Sheet2").Cells(4, 1)
            End With
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
    End With
End Sub

         filter_rows_union_columns
            Sample data on Sheet1

         filter_rows_union_columns_results
            Results on Sheet2

Post Status

Asked in February 2016
Viewed 2,609 times
Voted 4
Answered 1 times

Search




Leave an answer


Quote of the day: live life