SIMPLYFYING CODE AND A SMALL QUERY

[srikanth sare]

Help me in simplifying code and
Sheet9.Range("EG5:EG" & Range("EG9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)

here two columns has to be copied i.e., EF & EG to column FN & FO

If Sheet9.Range("EF2").Value = "YES" Then
        Sheet9.Range("EG5:EG" & Range("EG9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("EH2").Value = "YES" Then
        Sheet9.Range("EI5:EI" & Range("EI9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("EJ2").Value = "YES" Then
        Sheet9.Range("EK5:EK" & Range("EK9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("EL2").Value = "YES" Then
        Sheet9.Range("EM5:EM" & Range("EM9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("EN2").Value = "YES" Then
        Sheet9.Range("EO5:EO" & Range("EO9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("EP2").Value = "YES" Then
        Sheet9.Range("EQ5:EQ" & Range("EQ9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("ER2").Value = "YES" Then
        Sheet9.Range("ES5:ES" & Range("ES9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("ET2").Value = "YES" Then
        Sheet9.Range("EU5:EU" & Range("EU9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("EV2").Value = "YES" Then
        Sheet9.Range("EW5:EW" & Range("EW9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("EX2").Value = "YES" Then
        Sheet9.Range("EY5:EY" & Range("EY9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("EZ2").Value = "YES" Then
        Sheet9.Range("FA5:FA" & Range("FA9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("FB2").Value = "YES" Then
        Sheet9.Range("FC5:FC" & Range("FC9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("FD2").Value = "YES" Then
        Sheet9.Range("FE5:FE" & Range("FE9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("FF2").Value = "YES" Then
        Sheet9.Range("FG5:FG" & Range("FG9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("FH2").Value = "YES" Then
        Sheet9.Range("FI5:FI" & Range("FI9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If
        If Sheet9.Range("FJ2").Value = "YES" Then
        Sheet9.Range("FK5:FK" & Range("FK9999").End(xlUp).Row).Copy Sheet9.Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
        End If[CODE=vba]

[/CODE]

 

[Peter_SSs]

This seems to do the same thing as your existing code. I'm not sure what the "and a small query" part of your thread title means.

Sub Test1()
  Dim c As Long
  
  With Sheet9
    For c = 136 To 166 Step 2
      If .Cells(2, c).Value = "YES" Then .Range(.Cells(5, c + 1), .Cells(Rows.Count, c + 1).End(xlUp)).Copy .Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
    Next c
  End With
End Sub

 

[srikanth sare]

This seems to do the same thing as your existing code. I'm not sure what the "and a small query" part of your thread title means.

Sub Test1()
  Dim c As Long
 
  With Sheet9
    For c = 136 To 166 Step 2
      If .Cells(2, c).Value = "YES" Then .Range(.Cells(5, c + 1), .Cells(Rows.Count, c + 1).End(xlUp)).Copy .Cells(Rows.Count, "FO").End(xlUp).Offset(1, 0)
    Next c
  End With
End Sub

That worked perfectly
Small Query is I have to include two columns 136 & 137

here .Range(.Cells(5, c + 1) i used C but that's not working

 

[Peter_SSs]

Small Query is I have to include two columns 136 & 137

That is still not clear to me. Can you give a small set of sample data and expected results and/or explain more clearly in words.
The current code "looks at row 2 of every second column starting at column 136. If it finds "YES" it copies everything in the next column from row 5 down, to the bottom of column FO."
Can you put the new requirement into clear wording like that?

 

[srikanth sare]

That is still not clear to me. Can you give a small set of sample data and expected results and/or explain more clearly in words.
The current code "looks at row 2 of every second column starting at column 136. If it finds "YES" it copies everything in the next column from row 5 down, to the bottom of column FO."
Can you put the new requirement into clear wording like that?

In the below image

column EJ is not copying with the above code to the column FN

The code should copy both columns at a time one by one to the column FN & FO

with above code only one column is copying to the column FO

Please help me in formulating the VBA Code.

 

[Peter_SSs]

In the below image

column EJ is not copying with the above code to the column FN

The code should copy both columns at a time one by one to the column FN & FO

with above code only one column is copying to the column FO

Of course, in the image I cannot actually see which columns are which and the same for rows.
However, I think this is what you are wanting.

Sub Test2()
  Dim c As Long
  
  With Sheet9
    For c = 136 To 166 Step 2
      If .Cells(2, c).Value = "YES" Then .Range(.Cells(5, c), .Cells(Rows.Count, c).End(xlUp).Resize(, 2)).Copy .Cells(Rows.Count, "FN").End(xlUp).Offset(1, 0)
    Next c
  End With
End Sub