Reference to cells that meet a condition

[fontmar]

Hi,

I have the A column with 215 rows and each row can contain no value ("") or 1. I should select all rows with 1 and copy the 5 cells on the right on a different column.

So, for example, if the value 1 is in A5, A34, A55 and A89, I should copy B5:F5 in C1 (C1:G1), B34:F34 in C2 (C2:G2), B55:F55 in C3 (C3:G3), B89:F89 in C4 (C4:G4) and so on...

Somebody can help me?

Thanks
M

 

[L. Howard]

Hi M,

You don't say where the destination C1:G1 (and the others) is, I assume it is on another sheet and I used Sheet4. You will need to change Sheet4 to your sheet name to suit the copy destination in your worksheet.

There are two macros, first one will work if there is NO other data in the columns H and beyond, otherwise that data will be copied also and you only want B to F.
The second macro assumes there IS data in column H and beyond and will only copy B to F and ignore the stuff in columns H and beyond. Also copies to Sheet4, so change the name here too.

Copy macros to a standard module and run from the sheet with the data on it.

Howard

Option Explicit

[B]'/ Use this macro if there is NO data beyond column F[/B]
Sub Vis_Cells_Copy()

With ActiveSheet

    If WorksheetFunction.CountIf(.Columns(1), 1) <> 0 Then
    
        .AutoFilterMode = False
        .Range("A1:A215").AutoFilter
        .Range("A1:A215").AutoFilter Field:=1, Criteria1:=1
        .UsedRange.SpecialCells(xlCellTypeVisible).Copy _
         Destination:=Sheet4.Range("C1")
        .AutoFilterMode = False
        Application.CutCopyMode = False
        
    End If
    
End With
End Sub



[B]'/ Use this macro if you have data beyond column F and you don't want it copied[/B]
Sub Vis_Cells_Copy_BF()

Dim lRow As Long

With ActiveSheet

lRow = Cells(Rows.Count, 2).End(xlUp).Row

    If WorksheetFunction.CountIf(.Columns(1), 1) <> 0 Then
    
        .AutoFilterMode = False
        .Range("A1:A215").AutoFilter
        .Range("A1:A215").AutoFilter Field:=1, Criteria1:=1
        .Range("B1:F" & lRow).Copy Destination:=Sheet4.Range("C1")
        .AutoFilterMode = False
        Application.CutCopyMode = False
        
    End If
    
End With
End Sub

 

[fontmar]

thanks a lot, it works perfectly

 

[L. Howard]

You're welcome, thanks for the feedback.

Howard

 

[fontmar]

Hi Howard, it's me again (Marco).

I've tried to use the second macro - from B to F -, but it doesn't work. I have a Run.time error 1004, Application.defined or object-defined error.

Is there anything I'm doing wrong?

 

[L. Howard]

Try this, does not copy the 1's in column A and only copies from B to F columns.

Howard

Option Explicit

Sub Cells_Copy_BF_No_A()

Dim lRow As Long

With ActiveSheet

lRow = Cells(Rows.Count, 2).End(xlUp).Row

    If WorksheetFunction.CountIf(.Columns(1), 1) <> 0 Then
    
        .AutoFilterMode = False
        .Range("A1:A215").AutoFilter
        .Range("A1:A215").AutoFilter Field:=1, Criteria1:=1
        .Range("B1:F" & lRow).Copy Destination:=Sheet2.Range("C1")
        .AutoFilterMode = False
        Application.CutCopyMode = False
        
    End If
    
End With
End Sub

 

[fontmar]

Hi Howard,
now it works.

Thanks a lot
Ciao
Marco