Aşağıdaki gibi giden döngüde bir makrom var 1800 den sonra too large diye uyarı veriyor ve benim bu döngü ile işlemem gereken 200 000 e yakın satır var.
İstediğim şey ise, bu döngü bittikten sonra ben hiç bir tuşa basmadan döngü benim belirlediğim sayı kadar tekrar etsin.
Yardımcı olabilecek olamayacak zaman ayıran herkese şimdiden teşekkürler.
Sub Makro6()
'
' Makro6 Makro
'
' Klavye Kısayolu: Ctrl+Shift+Q
'
Range("C4:J4").Select
Selection.Copy
Range("C8").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.
.
.
.
.
Range("c1800").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("1800:1800").Select
ActiveWindow.ScrollRow = 1801
ActiveWindow.ScrollRow = 1
Rows("5:1800").Select
Range("A1800").Activate
Application.CutCopyMode = False
Selection.Cut
ActiveWindow.ScrollRow = 1801
ActiveWindow.ScrollRow = 126270
ActiveWindow.SmallScroll Down:=5
Rows("126270:126270").Select
Selection.Insert Shift:=xlDown
ActiveWindow.ScrollRow = 1
End Sub
İstediğim şey ise, bu döngü bittikten sonra ben hiç bir tuşa basmadan döngü benim belirlediğim sayı kadar tekrar etsin.
Yardımcı olabilecek olamayacak zaman ayıran herkese şimdiden teşekkürler.
Sub Makro6()
'
' Makro6 Makro
'
' Klavye Kısayolu: Ctrl+Shift+Q
'
Range("C4:J4").Select
Selection.Copy
Range("C8").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.
.
.
.
.
Range("c1800").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("1800:1800").Select
ActiveWindow.ScrollRow = 1801
ActiveWindow.ScrollRow = 1
Rows("5:1800").Select
Range("A1800").Activate
Application.CutCopyMode = False
Selection.Cut
ActiveWindow.ScrollRow = 1801
ActiveWindow.ScrollRow = 126270
ActiveWindow.SmallScroll Down:=5
Rows("126270:126270").Select
Selection.Insert Shift:=xlDown
ActiveWindow.ScrollRow = 1
End Sub