VBA для циклического набора строк строк

Question

У меня есть следующий код, который обновляет данные в «Листе аудита» с конкретными данными на листе «Мастер», печатает лист «Аудит» и циклы до тех пор, пока последняя строка не будет пуста. Он отлично работает для небольшого объема данных, но у меня есть еще один проект, который будет содержать более 1800 строк данных. Я не хочу засорять принтер с 1800 страницами одновременно.

Что я хочу, чтобы иметь возможность всплывать окно и указывать начальную строку и конечную строку. Я делал это раньше, но за многие годы я забыл, как я изначально написал код. Любая помощь приветствуется.

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 

Answer 1

Вы хотите перебирает объект диапазона в манере, аналогичной

dim rngobj, userinputstart, userinputend as variant 

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

В зависимости от того, как вы захватить ввод данных пользователя вы будете иметь, чтобы возиться с этой частью.

Answer 2

Спасибо всем, кто разместил. Наконец я понял, что лучше всего работает. Вот мой готовый код, и он отлично работает.

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