Scott P
Scott P

Reputation: 29

How to loop based on cell value?

This code is meant to copy and paste x number of times based on a cell value.

It bugs out and doesn't stop the loop.
When I step into it, it runs once and stops.

"O7" is how many times I would like to copy and paste.

Sub WorksheetLoop()
Dim NS As Integer
NS = Sheets("Dashboard").Range("O7").Value
i = 1

Do

    Sheets("Dashboard").Select
    Sheets("Dashboard").Range("A9").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Archive").Select
    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & lMaxRows + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
        
    i = i + 1

Loop Until i = NS
                    
MsgBox "loop Complete"
        
End Sub

Upvotes: 1

Views: 1606

Answers (1)

VBasic2008
VBasic2008

Reputation: 55018

Worksheet Loop

Tips

  • Read here about how to avoid to use Select.
  • If a range is always the same, keep it out of (before) the loop.
  • Use variables.
  • Access each worksheet as few times as possible.
  • Note how I used i (i = 0 by default): increasing only after copying. In your solution the last instance of the range would not have been copied.

The Code

Option Explicit

Sub WorksheetLoop()
    
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim i As Long
    
    Dim dst As Worksheet
    Set dst = wb.Worksheets("Archive")
    Dim cel As Range
    
    Dim src As Worksheet
    Set src = wb.Worksheets("Dashboard")
    Dim NS As Long
    NS = src.Range("O7").Value
    Dim rng As Range
    Set rng = src.Range("A9", src.Range("A9").End(xlDown))
    Set rng = rng.SpecialCells(xlCellTypeVisible)
    
    Application.ScreenUpdating = False
        
    rng.Copy
    
    Do
        Set cel = dst.Cells(dst.Rows.Count, "A").End(xlUp).Offset(1)
        cel.PasteSpecial xlPasteValues
        i = i + 1
    Loop Until i = NS
    
    Application.CutCopyMode = False
    
    Application.ScreenUpdating = True
    
    MsgBox "loop Complete", vbInformation, "Success"
            
End Sub

Upvotes: 1

Related Questions