VBA Loop and copy regions from sheet to sheet

Question

I am trying to loop down the column "Q" on my active sheet, find values that are in between 27 and 40 and then copy that cell along with a region around the cell noted by the (-1, -16) into a new sheet.

Right now I am just making the region bold to make sure that my loop is catching the right values and regions.

I"m new to VBA so if anyone can give me some pointers or advise on how to solve my problem I'd be very appreciative.

Sub Test2()
Application.ScreenUpdating = False
ActiveSheet.Range("Q13").Select
Let x = 0
Do While x < 500
    If ActiveCell.Value >= 27 And ActiveCell.Value <= 40 Then
        Range(ActiveCell, ActiveCell.Offset(-1, -16)).Select
        Selection.Font.Bold = True
        ActiveCell.Offset(2, 16).Activate
    Else
        ActiveCell.Offset(1, 0).Select
    End If
    x = x + 1
Loop
End Sub

Answer 1

Try below code :

• Always set the ScreenUpdating property back to True when your macro ends.Check this link
• Avoid using Select/Activate in your code. Check this link
• Always explicitly specify the sheet when working with more than one sheet.
• Avoid using ActiveCell,ActiveSheet and refer to them explicitly.
  

Sub Test2()

    Application.ScreenUpdating = False


    Dim lastRow As Long
    lastRow = Sheets("sheet1").Range("Q" & Rows.Count).End(xlUp).Row

    Dim rng As Range, cell As Range
    Set rng = Sheets("sheet1").Range("Q1:Q" & lastRow)

    For Each cell In rng

        If cell.Value >= 27 And cell.Value <= 40 Then
            Sheets("sheet1").Range(cell, cell.Offset(0, -16)).Copy Sheets("sheet2").Cells(Sheets("sheet2").Range("Q" & Rows.Count).End(xlUp).Row + 1, 1)
        End If
    Next

    Application.ScreenUpdating = True
End Sub