Excel Makro - Bir işlemi tekrarlayın

Question

Excel'de basit bir işlem için kayıtlı bir makro var. Ancak, yaklaşık 80 satırlık işlemi tekrarlamak gerekiyor. İşte ilk 4 satır için sahip olduğum kod. Bunu yapmak için basit bir şekilde herhangi bir yardım takdir edilecektir. Teşekkür ederim.

Sub Macro2() 
' 
' Macro2 Macro 
' 

' 
Range("A5").Select 
ActiveCell.FormulaR1C1 = "1" 
Sheets("EST COST").Select 
Range("D6").Select 
Selection.Copy 
Sheets("IL").Select 
Range("I5").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Range("A5").Select 
ActiveCell.FormulaR1C1 = "0" 

Range("A6").Select 
ActiveCell.FormulaR1C1 = "1" 
Sheets("EST COST").Select 
Range("D6").Select 
Selection.Copy 
Sheets("IL").Select 
Range("I6").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Range("A6").Select 
ActiveCell.FormulaR1C1 = "0" 

Range("A7").Select 
ActiveCell.FormulaR1C1 = "1" 
Sheets("EST COST").Select 
Range("D6").Select 
Selection.Copy 
Sheets("IL").Select 
Range("I7").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Range("A7").Select 
ActiveCell.FormulaR1C1 = "0" 
End Sub 

Answer 1

Bunun için bir sonraki ... kullanmak istiyorsunuz. Bazı Googling oldukça uzağa götürmez, ancak genel yaklaşım fikrinin bir lezzet olmalıdır:

dim startRow as integer 
dim endRow as integer 
dim myColumn as integer 

startRow = 5 
endRow = 45 
For activeRow = startRow to endRow 
    [do something] 
    myColumn = [some column number] 
    cells(activeRow, myColumn).Value = [something] 
Next activeRow 

Answer 2

şey böyle

Sub test() 

    Dim wsTarget As Worksheet 
    Dim wsSource As Worksheet 

    Set wsTarget = Sheets("EST COST") 
    Set wsSource = Sheets("IL") 

    Dim intIndex As Integer 
    For intIndex = 5 To 85 

     wsTarget.Range("A" & intIndex).FormulaR1C1 = "1" 
     wsTarget.Range("D" & intIndex).Copy 
     With wsSource 
      .Range("I" & intIndex).PasteSpecial Paste:=xlPasteValues _ 
      , Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

      .Range("A" & intIndex).FormulaR1C1 = "0" 
     End With 
    Next 

End Sub 

Answer 3

sende olduğunca benzer kodunuzu tutmak için, bu deneyin:

Sub test() 
Dim rng As Range 
Dim i& 

For i = 5 To 40 
' WHAT SHEET IS YOUR DEFAULT RANGES ON? 
Range("A" & i).FormulaR1C1 = "1" ' what sheet is this on? We want to be explicit 
Sheets("EST COST").Range("D" & i + 1).Copy 
Sheets("IL").Range("I" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Range("A" & i).FormulaR1C1 = "0" 
Next i 

End Sub 

Yapıştırılan aralığın bir satır ofset olmasını istediğinizi varsayalım (A5'i kopyalayıp, I6'ya yapıştırılmış). Yine de belirttiğim gibi, kopyalanacak aralığınızın hangi sayfada olduğunu bilmeyi tercih ediyorum, bu yüzden bu çalışma sayfasını aralığa ekleyebiliriz (gerçekten Sheets("mainSheet").Range("A"&i)... olmalıdır.)