简体   繁体   中英

VBA to loop through set rows

I have the code below that updates data on the "Audit Sheet" with specific data from the "Master" sheet, prints the "Audit" sheet and loops until the last row is empty. It works great for a small amount of data, but I have another project that will have over 1800 rows of data. I don't want to clog up the printer with 1800 pages all at once.

What I want is to be able to have a box pop up and specify the beginning row and ending row. I have done this before, but I have forgotten over the years of how I originally wrote the code. Any help is appreciated.

Sub testLoopPaste()

Dim i As Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet

Set wb = ThisWorkbook
Set sht1 = wb.Sheets("Master")
Set sht2 = wb.Sheets("Audit Sheet")

Application.ScreenUpdating = False

'Find the last row (in column A) with data.
LastRow = sht1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row

'This is the beginning of the loop
For i = 2 To LastRow
    'First activity
    sht2.Range("B1" & ii) = sht1.Range("B" & i).Value
    sht2.Range("B2" & ii) = sht1.Range("A" & i).Value
    sht2.Range("B3" & ii) = sht1.Range("N" & i).Value
    sht2.Range("H1" & ii) = sht1.Range("C" & i).Value
    sht2.Range("H2" & ii) = sht1.Range("I" & i).Value
    sht2.Range("H3" & ii) = sht1.Range("F" & i).Value
    sht2.Range("K1" & ii) = sht1.Range("D" & i).Value

    sht2.PrintOut

Next i

Application.ScreenUpdating = True

End Sub

You want to loop over a range object in a manner similar to

dim rngobj, userinputstart, userinputend as variant

set rngobj = Range(Range(userinputstart),Range(userinputend))
For each therow in rngobj
    'do stuff here
Next

Depending on how you grab user input you're going to have to fiddle with that part.

Thank you to all who posted. I finally figured out what worked best. Here is my finished code and it works perfectly.

Sub testLoopPaste()

Dim i As Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet

Set wb = ThisWorkbook
Set sht1 = wb.Sheets("Master")
Set sht2 = wb.Sheets("Audit Sheet")

Application.ScreenUpdating = False
'Find the last row of data
LastRow = InputBox("Enter the last row of data", "End Row")

'This is the beginning of the loop
For i = InputBox("Enter the first row of data", "Start Row") To LastRow

    'First activity
    sht2.Range("B2" & ii) = sht1.Range("B" & i).Value
    sht2.Range("B4" & ii) = sht1.Range("C" & i).Value
    sht2.Range("B6" & ii) = sht1.Range("D" & i).Value
    sht2.Range("B8" & ii) = sht1.Range("L" & i).Value
    sht2.Range("B10" & ii) = sht1.Range("M" & i).Value
    sht2.Range("B12" & ii) = sht1.Range("N" & i).Value
    sht2.Range("B14" & ii) = sht1.Range("Q" & i).Value
    sht2.Range("B16" & ii) = sht1.Range("R" & i).Value
    sht2.Range("B18" & ii) = sht1.Range("AO" & i).Value
    sht2.Range("D2" & ii) = sht1.Range("J" & i).Value
    sht2.Range("D4" & ii) = sht1.Range("K" & i).Value
    sht2.Range("D6" & ii) = sht1.Range("O" & i).Value
    sht2.Range("D8" & ii) = sht1.Range("A" & i).Value
    sht2.Range("D10" & ii) = sht1.Range("AO" & i).Value
    sht2.Range("D12" & ii) = sht1.Range("T" & i).Value
    sht2.Range("D14" & ii) = sht1.Range("U" & i).Value
    sht2.Range("D16" & ii) = sht1.Range("V" & i).Value
    sht2.Range("D18" & ii) = sht1.Range("W" & i).Value
    sht2.Range("D20" & ii) = sht1.Range("X" & i).Value
    sht2.Range("D22" & ii) = sht1.Range("Y" & i).Value
    sht2.Range("D24" & ii) = sht1.Range("Z" & i).Value
    sht2.Range("D26" & ii) = sht1.Range("AA" & i).Value
    sht2.Range("D28" & ii) = sht1.Range("AB" & i).Value
    sht2.Range("D35" & ii) = sht1.Range("AT" & i).Value
    sht2.Range("D37" & ii) = sht1.Range("AV" & i).Value
    sht2.Range("D39" & ii) = sht1.Range("AX" & i).Value
    sht2.Range("D41" & ii) = sht1.Range("AZ" & i).Value
    sht2.Range("D43" & ii) = sht1.Range("BB" & i).Value
    sht2.Range("D45" & ii) = sht1.Range("BD" & i).Value
    sht2.Range("D47" & ii) = sht1.Range("BF" & i).Value
    sht2.Range("D49" & ii) = sht1.Range("BH" & i).Value
    sht2.Range("D51" & ii) = sht1.Range("BJ" & i).Value
    sht2.Range("D53" & ii) = sht1.Range("BL" & i).Value
    sht2.Range("D55" & ii) = sht1.Range("BN" & i).Value
    sht2.Range("I2" & ii) = sht1.Range("F" & i).Value
    sht2.Range("I4" & ii) = sht1.Range("G" & i).Value
    sht2.Range("I6" & ii) = sht1.Range("S" & i).Value
    sht2.Range("I8" & ii) = sht1.Range("AM" & i).Value
    sht2.Range("I10" & ii) = sht1.Range("AN" & i).Value
    sht2.Range("H12" & ii) = sht1.Range("AD" & i).Value
    sht2.Range("H14" & ii) = sht1.Range("AE" & i).Value
    sht2.Range("H16" & ii) = sht1.Range("AF" & i).Value
    sht2.Range("H18" & ii) = sht1.Range("AG" & i).Value
    sht2.Range("H20" & ii) = sht1.Range("AH" & i).Value
    sht2.Range("H22" & ii) = sht1.Range("AQ" & i).Value
    sht2.Range("H24" & ii) = sht1.Range("AI" & i).Value
    sht2.Range("H26" & ii) = sht1.Range("AJ" & i).Value
    sht2.Range("H28" & ii) = sht1.Range("AK" & i).Value
    sht2.Range("H30" & ii) = sht1.Range("AL" & i).Value
    sht2.Range("H35" & ii) = sht1.Range("AU" & i).Value
    sht2.Range("H37" & ii) = sht1.Range("AW" & i).Value
    sht2.Range("H39" & ii) = sht1.Range("AY" & i).Value
    sht2.Range("H41" & ii) = sht1.Range("BA" & i).Value
    sht2.Range("H43" & ii) = sht1.Range("BC" & i).Value
    sht2.Range("H45" & ii) = sht1.Range("BE" & i).Value
    sht2.Range("H47" & ii) = sht1.Range("BG" & i).Value
    sht2.Range("H49" & ii) = sht1.Range("BI" & i).Value
    sht2.Range("H51" & ii) = sht1.Range("BK" & i).Value
    sht2.Range("H53" & ii) = sht1.Range("BM" & i).Value
    sht2.Range("H55" & ii) = sht1.Range("BO" & i).Value

sht2.PrintOut

Next i

Application.ScreenUpdating = True

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM