Reputation: 29
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
Reputation: 55018
Tips
Select
.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