VBA Loop и копировать регионы от листа до листа

Question

Я пытаюсь пропустить столбец «Q» на моем активном листе, найти значения, находящиеся между 27 и 40, а затем скопировать эту ячейку вместе с областью вокруг ячейки (-1, -16) в новый лист.

Сейчас я просто делаю область полужирным шрифтом, чтобы убедиться, что моя петля ловит правильные значения и области.

Я "новичок в VBA, так что если кто-нибудь может дать мне несколько указателей или посоветовать, как решить мою проблему, я был бы очень благодарен

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 ниже код:.

• Всегда устанавливайте свойство ScreenUpdating обратно в True, когда ваш макрос ends.Check this link
• Избегайте использования Select/Activate в вашем коде. link
• Всегда указывайте лист при работе с более чем одним номером .
• Избегайте использования ActiveCell, ActiveSheet и явно ссылайтесь на них.
  

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