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

score 1 · Accepted Answer · edited May 23 '17 at 11:57

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

Thank you! This really helps. I am going to modify it a bit and I'll post my progress. — Ptrkcon, May 20 '13 at 04:35

VBA Loop and copy regions from sheet to sheet

1 Answers1