MAKRO ESITLEME

[ramazankaya89]

Arkadaslar Merhaba,
ekteki dosyamda sayfalar arasında for dongusu ıle esıtleme yapıyorum fakat cok uzun suruyor bunu nasıl dusurebılırım tek dongu olarak

For i = 2 To Sayfa2.Range("F2").End(xlDown).Row

Sayfa1.Cells(i, 1) = Sayfa2.Cells(i, 3)
Sayfa1.Cells(i, 2) = Sayfa2.Cells(i, 6)
Sayfa1.Cells(i, 4) = Sayfa2.Cells(i, 8)
Sayfa1.Cells(i, 5) = Sayfa2.Cells(i, 9)
Sayfa1.Cells(i, 6) = Sayfa2.Cells(i, 12)
Sayfa1.Cells(i, 7) = Sayfa2.Cells(i, 13)

Next


https://s2.dosya.tc/server29/1341om/ORNEK.xlsm.html

 

[dEdE]

Örnek dosyanızdaki makroya hiç müdahale etmeden çalıştırdım. Sonuç:


Aşağıdaki iki satırı ekledim.

Application.ScreenUpdating = False 'Eklenen satır
    For i = 2 To Sayfa2.Range("F2").End(xlDown).Row
        Sayfa1.Cells(i, 1) = Sayfa2.Cells(i, 3)
        Sayfa1.Cells(i, 2) = Sayfa2.Cells(i, 6)
        Sayfa1.Cells(i, 4) = Sayfa2.Cells(i, 8)
        Sayfa1.Cells(i, 5) = Sayfa2.Cells(i, 9)
        Sayfa1.Cells(i, 6) = Sayfa2.Cells(i, 12)
        Sayfa1.Cells(i, 7) = Sayfa2.Cells(i, 13)
    Next
Application.ScreenUpdating = True'Eklenen satır

Sonuç:

 

[veyselemre]

Sub Vade()
    Z = TimeValue(Now)
    Dim Sayfa1, Sayfa2, Sayfa3 As Worksheet, son&
    Dim i As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    Set Sayfa1 = Sheets("VADE")
    Set Sayfa2 = Sheets("p")
    'Set Sayfa3 = Sheets("045")

    son = Sayfa2.Range("F2").End(xlDown).Row
    Sayfa1.Range("A2:A" & son).Value = Sayfa2.Range("C2:C" & son).Value
    Sayfa1.Range("B2:B" & son).Value = Sayfa2.Range("F2:F" & son).Value
    Sayfa1.Range("D2:E" & son).Value = Sayfa2.Range("H2:I" & son).Value
    Sayfa1.Range("F2:G" & son).Value = Sayfa2.Range("L2:M" & son).Value

    'For i = 2 To Sayfa2.Range("F2").End(xlDown).Row
    '
    'Sayfa2.Cells(i, 20) = Right(Sayfa2.Cells(i, 18), 10)
    '
    'Next
    '
    '
    'For i = 2 To Sayfa1.Range("B2").End(xlDown).Row
    '
    'Sayfa1.Cells(i, 3) = Application.WorksheetFunction.VLookup(Sayfa1.Cells(i, 2), Sayfa3.Cells(i, 2), 2, 0)
    '
    'Next

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation =xlCalculationAutomatic
    End With

    MsgBox "İslem " & CDate(TimeValue(Now) - Z) & " Tamamlandı", vbInformation

End Sub

 

[ramazankaya89]

cok tesekkur ederım hocam herkese elınıze saglık demekkı benım pc ıle alakalı gec ıslem yapıyor