İyi günler. Aşağıdaki makroda, kodun içerisinden istenilen yerden başlayabilmesi için nasıl bir ekleme yapılması gerekiyor, yardımcı olur musunuz. Örnek dosya ektedir.
Örnek: 10. makro satırından başla veya 23. makro satırından başla veya 34. makro satırından başla vb.
http://dosya.pro/download.php?file=c9b6767b4ca938bbcea6c1f66e8a6a23
Örnek: 10. makro satırından başla veya 23. makro satırından başla veya 34. makro satırından başla vb.
http://dosya.pro/download.php?file=c9b6767b4ca938bbcea6c1f66e8a6a23
Kod:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Me.CommandButton1
Select Case .Caption
Case Is >= "1 - SAYFA" & Chr(11) & "OLUŞTUR" & Chr(11) & "1 - 250"
.Caption = "İŞLEM" & Chr(11) & "TAMAM"
.BackColor = vbGreen
End Select
End With
Sheets("Sablon").Copy After:=Sheets(ThisWorkbook.Worksheets.Count)
ActiveSheet.Name = "Sayfa1"
Sheets("Sayfa1").Activate
ActiveSheet.Rows("1:43").Select
Selection.Copy
ActiveSheet.Rows("44:44").Select
ActiveSheet.Paste
ActiveSheet.Rows("87:87").Select
ActiveSheet.Paste
ActiveSheet.Rows("130:130").Select
ActiveSheet.Paste
ActiveSheet.Rows("173:173").Select
ActiveSheet.Paste
ActiveSheet.Rows("216:216").Select
ActiveSheet.Paste
ActiveSheet.Rows("259:259").Select
ActiveSheet.Paste
ActiveSheet.Rows("302:302").Select
ActiveSheet.Paste
ActiveSheet.Rows("345:345").Select
ActiveSheet.Paste
ActiveSheet.Rows("388:388").Select
ActiveSheet.Paste
ActiveSheet.Rows("431:431").Select
ActiveSheet.Paste
ActiveSheet.Rows("474:474").Select
ActiveSheet.Paste
ActiveSheet.Rows("517:517").Select
ActiveSheet.Paste
ActiveSheet.Rows("560:560").Select
ActiveSheet.Paste
ActiveSheet.Rows("603:603").Select
ActiveSheet.Paste
ActiveSheet.Rows("646:646").Select
ActiveSheet.Paste
ActiveSheet.Rows("689:689").Select
ActiveSheet.Paste
ActiveSheet.Rows("732:732").Select
ActiveSheet.Paste
ActiveSheet.Rows("775:775").Select
ActiveSheet.Paste
ActiveSheet.Rows("818:818").Select
ActiveSheet.Paste
ActiveSheet.Rows("861:861").Select
ActiveSheet.Paste
ActiveSheet.Rows("904:904").Select
ActiveSheet.Paste
ActiveSheet.Rows("947:947").Select
ActiveSheet.Paste
ActiveSheet.Rows("990:990").Select
ActiveSheet.Paste
ActiveSheet.Rows("1033:1033").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("A1").Select
Sheets("Bilgiler").Activate
Application.ScreenUpdating = False
Application.DisplayAlerts = False
MsgBox "İŞLEM TAMAMLANDI.", vbInformation
End Sub
