Sonraki satır aşağı kendini tekrarlamak için Makro

Question

İlk satırda işe yarayan bu makroyu kullanıyorum, ancak tamamlandığında bir sonraki satırda tekrar çalışmasını ve sonucu sonraki satırda yapıştırmasını istiyorum. (yaklaşık vardır tablomda 5300 kayıtları.)

Sub Macro2() 
    ' Macro2 Macro 

    Range("A2:BW2").Select 
    Selection.Copy 
    Sheets("Lookup").Select 
    Range("F3").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    Range("F3:V3").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Result").Select 
    Range("A2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

End Sub 

Böylece temelde sayfadaki verilere ilk satırını kopyalayarak ediyorum - bu son rekor ulaşana kadar "sonuç" sac ve bütün belge üzerinden işlemine devam "amps_job_history" olarak adlandırılır, bu verileri "arama" adlı bir sayfaya yapıştırır, veri bir kez yapıştırıldığında bir formül, verileri başka bir çalışma sayfasındaki verilerle eşleştiren bir hesaplama yapar. Daha sonra, orijinal verilere ek olarak, verilere bağlı olan fazladan 3 sütunu formüllerle kopyalayıp "sonuç" olarak adlandırılan sayfaya yapıştırmak istiyorum. Daha sonra ilk sayfadaki "amps_job_hisotry" sayfasına geri dönmek ve bir sonraki veri dizisine geçmek ve işlemi tekrarlamak istiyorum ve verileri bir sonraki satırda geçmesi gereken "sonuç" sayfasına yapıştırarak ve son kayda ulaşıncaya kadar.

Answer 1

Bu döngü sizin aradığınız şey olduğunu düşünüyorum. amps_job_history ve hedef Sonuç, çalışma kaynak veri

Sub Macro2() 
    ' Macro2 Macro 
    Dim rw As Long 

    With Worksheets("amps_job_history") 
     For rw = 2 To .Cells(Rows.Count, "A").End(xlUp).Row 
      With Intersect(.Range("A:BW"), .Rows(rw)) 
       Worksheets("Lookup").Range("F3").Resize(.Rows.Count, .Columns.Count) = .Value 
      End With 

      With Worksheets("Lookup") 
       With .Range("F3:V3") 
        Worksheets("Result").Range("A1").Offset(rw - 1, 0).Resize(.Rows.Count, .Columns.Count) = .Value 
       End With 
      End With 
     Next rw 
    End With 

End Sub 

sıraları, her döngü, bir satırı daha aşağıya kaydırılır. Arama çalışma sayfasındaki geçiş F3: V3 aralığı dışarıda aynı kalır.

Ben kullanılması doğrudan değer transferi yerine kopyasını yapıştırmak özel, değerlerini ettik ve With ... End With statementRange .Select veya Range .Activate yöntemleri kullanmadan açık ebeveyn çalışma sayfası referanslamaya sağlarlar.