Makro kodu kısaltma

recepkull · 15 Aralık 2018

Arkadaşlar 370 tane sayfayı ilgilendiren bir makro kodu yazmam gerekiyor. Aşağıdaki kod 10 sayfa için yazılmış olmasına rağmen oldukça uzun ben bunu 370 sayfaya kadar yazmaya devam edersem çok fazla uzun bir kod ortaya çıkacak bunun daha kısa bir yolu var mıdır acaba ? Yardımlarınızı bekliyorum.

Kod:

Sub Kaydet()
'
' Kaydet Makro
'

'
    If MsgBox("Uyarı! Yanlış tarih girilmesi bazı raporların silinmesine neden olabilir. Devam edilsin mi?", vbYesNo) = vbNo Then Exit Sub
   
  ' Sayfa 1
 
    Sheets("Veri").Visible = True
    Sheets("Veri").Select
    If Range("Z3") = 1 Then
    Range("P9:X26").Copy
    Sheets("1").Select
    Range("N14:V31").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("Q3:T3").Copy
    Sheets("1").Select
    Range("O8:R8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("V3:X3").Copy
    Range("AB3").Select
    Sheets("1").Select
    Range("T8:V8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("C14").Select
    Application.CutCopyMode = False
    Sheets("Veri").Visible = False
   
   
  ' Sayfa 2
 
  ElseIf Range("Z3") = 2 Then
   
    Sheets("Veri").Visible = True
    Sheets("Veri").Select
    Range("P9:X26").Copy
    Sheets("2").Select
    Range("N14:V31").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("Q3:T3").Copy
    Sheets("2").Select
    Range("O8:R8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("V3:X3").Copy
    Range("AB3").Select
    Sheets("2").Select
    Range("T8:V8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("C14").Select
    Application.CutCopyMode = False
    Sheets("Veri").Visible = False
   
   
  ' Sayfa 3
   
  ElseIf Range("Z3") = 3 Then
   
    Sheets("Veri").Visible = True
    Sheets("Veri").Select
    Range("P9:X26").Copy
    Sheets("3").Select
    Range("N14:V31").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("Q3:T3").Copy
    Sheets("3").Select
    Range("O8:R8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("V3:X3").Copy
    Range("AB3").Select
    Sheets("3").Select
    Range("T8:V8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("C14").Select
    Application.CutCopyMode = False
    Sheets("Veri").Visible = False
   
   
      ' Sayfa 4
   
  ElseIf Range("Z3") = 4 Then
   
    Sheets("Veri").Visible = True
    Sheets("Veri").Select
    Range("P9:X26").Copy
    Sheets("4").Select
    Range("N14:V31").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("Q3:T3").Copy
    Sheets("4").Select
    Range("O8:R8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("V3:X3").Copy
    Range("AB3").Select
    Sheets("4").Select
    Range("T8:V8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("C14").Select
    Application.CutCopyMode = False
    Sheets("Veri").Visible = False
   
   
  ' Sayfa 5
   
  ElseIf Range("Z3") = 5 Then
   
    Sheets("Veri").Visible = True
    Sheets("Veri").Select
    Range("P9:X26").Copy
    Sheets("5").Select
    Range("N14:V31").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("Q3:T3").Copy
    Sheets("5").Select
    Range("O8:R8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("V3:X3").Copy
    Range("AB3").Select
    Sheets("5").Select
    Range("T8:V8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("C14").Select
    Application.CutCopyMode = False
    Sheets("Veri").Visible = False
   
   
  ' Sayfa 6
   
  ElseIf Range("Z3") = 6 Then
   
    Sheets("Veri").Visible = True
    Sheets("Veri").Select
    Range("P9:X26").Copy
    Sheets("6").Select
    Range("N14:V31").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("Q3:T3").Copy
    Sheets("6").Select
    Range("O8:R8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("V3:X3").Copy
    Range("AB3").Select
    Sheets("6").Select
    Range("T8:V8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("C14").Select
    Application.CutCopyMode = False
    Sheets("Veri").Visible = False
   
  ' Sayfa 7
   
  ElseIf Range("Z3") = 7 Then
   
    Sheets("Veri").Visible = True
    Sheets("Veri").Select
    Range("P9:X26").Copy
    Sheets("7").Select
    Range("N14:V31").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("Q3:T3").Copy
    Sheets("7").Select
    Range("O8:R8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("V3:X3").Copy
    Range("AB3").Select
    Sheets("7").Select
    Range("T8:V8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("C14").Select
    Application.CutCopyMode = False
    Sheets("Veri").Visible = False
   
   
  ' Sayfa 8
   
  ElseIf Range("Z3") = 8 Then
   
    Sheets("Veri").Visible = True
    Sheets("Veri").Select
    Range("P9:X26").Copy
    Sheets("8").Select
    Range("N14:V31").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("Q3:T3").Copy
    Sheets("8").Select
    Range("O8:R8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("V3:X3").Copy
    Range("AB3").Select
    Sheets("8").Select
    Range("T8:V8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("C14").Select
    Application.CutCopyMode = False
    Sheets("Veri").Visible = False
   
   
  ' Sayfa 9
   
  ElseIf Range("Z3") = 9 Then
   
    Sheets("Veri").Visible = True
    Sheets("Veri").Select
    Range("P9:X26").Copy
    Sheets("9").Select
    Range("N14:V31").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("Q3:T3").Copy
    Sheets("9").Select
    Range("O8:R8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("V3:X3").Copy
    Range("AB3").Select
    Sheets("9").Select
    Range("T8:V8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("C14").Select
    Application.CutCopyMode = False
    Sheets("Veri").Visible = False
   
   
  ' Sayfa 10
   
  ElseIf Range("Z3") = 10 Then
   
    Sheets("Veri").Visible = True
    Sheets("Veri").Select
    Range("P9:X26").Copy
    Sheets("10").Select
    Range("N14:V31").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("Q3:T3").Copy
    Sheets("10").Select
    Range("O8:R8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
   
    Sheets("Veri").Select
    Range("V3:X3").Copy
    Range("AB3").Select
    Sheets("10").Select
    Range("T8:V8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("C14").Select
    Application.CutCopyMode = False
    Sheets("Veri").Visible = False
   
   

   
   
    Else
    MsgBox "Yanlış tarih girildi."
   
   
   
   
   
   
   
   
End If
End Sub

alicimri · 15 Aralık 2018

Tekrarlayan kodları aşağıdaki gibi kısaltabilirsiniz.

Kod:

Sheets("Veri").Visible = True
    Sheets("Veri").Select
    Range("P9:X26").Copy
sayfa = Range("Z3")
    Sheets(sayfa).Select
    Range("N14:V31").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Veri").Select
    Range("Q3:T3").Copy
    Sheets(sayfa).Select
    Range("O8:R8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Veri").Select
    Range("V3:X3").Copy
    Range("AB3").Select
    Sheets(sayfa).Select
    Range("T8:V8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("C14").Select
    Application.CutCopyMode = False
    Sheets("Veri").Visible = False

Sayfaları seçmeden de copy paste yapıla bilinir Range("AB3").Select, Range("C14").Select satırları gereksizse aşağıdaki kodu kullanabilirsiniz.

alicimri · 15 Aralık 2018

Kod:

Sheets("Veri").Visible = True
    Sheets("Veri").Select
sayfa = Range("Z3")
    Sheets("Veri").Range("P9:X26").Copy
    Sheets(sayfa).Range("N14:V31").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Veri").Range("Q3:T3").Copy
    Sheets(sayfa).Range("O8:R8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Veri").Range("V3:X3").Copy
    Sheets(sayfa).Range("T8:V8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Veri").Visible = False

recepkull · 15 Aralık 2018

İlgilendiğiniz için çok teşekkür ederim ancak kod içerisinde sayfa seçimi belirtmeden nasıl başka bir sayfadan kopyalama yapılabilir anlayamadım. Ayrıca verdiğim kodda eğer fonksiyonu var siz verdiğiniz kodda eğer fonksiyonunu da kaldırmışsınız sanırım.

Orion1 · 15 Aralık 2018

recepkull' Alıntı:
İlgilendiğiniz için çok teşekkür ederim ancak kod içerisinde sayfa seçimi belirtmeden nasıl başka bir sayfadan kopyalama yapılabilir anlayamadım.

Diyelim ki sayfa1,sayfa2,sayfa3 olsun.
kodları sayfa1 den çalıştıracaksınız.
Sayfa2 yi seçmeden sayfa2 deki A1:A10 arasını kopyalayıp,Sayfa3 ü seçmeden sayfa3 B1 e yapıştıracaksınız.
Aşağıdaki kod bu işi yapıyor.

Kod:

Sheets("Sayfa2").Range("A1:A10").Copy Sheets("Sayfa3").Range("B1")

recepkull · 15 Aralık 2018

Anladım hocam teşekkür ederim. Anladığım kadarıyla yukarıda verdiğim kodda sadece sayfa seçimini kaldırarak kısaltabiliyoruz.

Orion1 · 15 Aralık 2018

recepkull' Alıntı:
Anladım hocam teşekkür ederim. Anladığım kadarıyla yukarıda verdiğim kodda sadece sayfa seçimini kaldırarak kısaltabiliyoruz.

Hayır,dahada kısalabilir mesela yapıştırılacak sayfalar 1,2,3,4,....n diye gidiyorsa onlar döngüye girerek yapıştırlabilir.Kopyalanacak alanlardada bir disiplin varsa onlarda ve belli bir düzende kopyalanabilir.Örnek dosyayı eklerseniz ve içinde açıklamalar yazarsanız çözüm bulacak arkadaşlar çıkacaktır.
Eklediğiniz sayfadaki veriler gerçek olmasın uyduruk veriler yazabilirsiniz.Verilerinde tamamını değilde 5-10 satırlık veriler olacak şekilde yaparsanız iyi olur.

recepkull · 15 Aralık 2018

Buyrun hocam örnek dosya ekledim. 1,2,3,4.... diye giden sayfaları bir döngüye sokup kodu kısaltmak istiyorum. Çünkü asıl dosyamda yapıştırılacak sayfalar 1,2,3,4,....,370 e kadar gidiyor.

https://www.dosyaupload.com/a77a

Ziynettin · 15 Aralık 2018

Bu olabilir mi?

Kod:

Sub test()
    Range("C4:D11").Select
    Selection.Copy
    Sheets(CStr([F2])).Select
    ActiveSheet.Range("C4").Select
    ActiveSheet.Paste
End Sub

Necdet · 15 Aralık 2018

Yapılmak istenen bana çok yanlış geldi ama aşağıdaki kodları deneyin.

Kod:

Sub Aktar()

    Dim Syf As String, _
        i   As Long
    
    Syf = Range("F2")
    
    i = Cells(Rows.Count, "B").End(3).Row
    
    Range("C4:D" & i).Copy Sheets(Syf).Range("C4")
    
End Sub

Orion1 · 15 Aralık 2018

For i = 1 to 10 Yukarıdaki 10 yazan yere 370 yazınız.

Kodlar aşağıdadır.

Kod:

Sub kopyala_yapistir59()
Dim sh As Worksheet, sonsat As Long
sonsat = Cells(Rows.Count, "B").End(xlUp).Row
Range("B4:D" & sonsat).Copy
For i = 1 To 10 'sayfa adediniz 370 ise 10 yazan yere 370 yazın.
    Set sh = Sheets(CStr(i))
    sh.Range("B4:D" & Rows.Count).ClearContents
Next i
Range("B4:D" & sonsat).Copy
For i = 1 To 10
    Set sh = Sheets(CStr(i))
    sh.Range("B4").PasteSpecial
Next i
Application.CutCopyMode = False
MsgBox "bitti"
End Sub

recepkull · 15 Aralık 2018

Herkese zaman ayırıp ilgilendiği için çok teşekkür ediyorum. @Orion1 hocam sizin verdiğiniz kodu çalıştırdığımda veri sayfasındaki içeriği tüm sayfalara kopyalıyor. @Necdet hocam sizin verdiğin kod tam istediğim gibi çalışıyor. Ancak merak ettim neden bu işlem size yanlış geldi. Öneriniz yanlışımı düzeltmem için önemli olacaktır.

Orion1 · 15 Aralık 2018

recepkull' Alıntı:
Herkese zaman ayırıp ilgilendiği için çok teşekkür ediyorum. @Orion1 hocam sizin verdiğiniz kodu çalıştırdığımda veri sayfasındaki içeriği tüm sayfalara kopyalıyor. @Necdet hocam sizin verdiğin kod tam istediğim gibi çalışıyor. Ancak merak ettim neden bu işlem size yanlış geldi. Öneriniz yanlışımı düzeltmem için önemli olacaktır.

Siz öyle istediniz.370 sayfa dediniz.Bana yolladığınız dosyada 10 adet vardı , onlara kopyalıyor.Ayrıca tüm içeriği değil B: D aralığında B sütununda en son kaç satır varsa onu kopyalıyor.

recepkull · 16 Aralık 2018

@Orion1 hocam bu saatte benim sorunumla ilgilendiğin için gerçekten çok teşekkür ederim Allah razı olsun.

Orion1 · 16 Aralık 2018

recepkull' Alıntı:
@Orion1 hocam bu saatte benim sorunumla ilgilendiğin için gerçekten çok teşekkür ederim Allah razı olsun.

Tamamda neresi olmadı?Onu söyleyin bari!!

recepkull · 16 Aralık 2018

Benim istediğim F2 hücresi kaç ise Veri sayfasını o sayfaya kopyalasın. Örnek F2 hücresi 5 ise Veri sayfasını 5. sayfaya kopyalayacak 9 ise 9. sayfaya kopyalayacak. Necdet hocamın verdiği kod gibi.

Orion1 · 16 Aralık 2018

recepkull' Alıntı:
Benim istediğim F2 hücresi kaç ise Veri sayfasını o sayfaya kopyalasın. Örnek F2 hücresi 5 ise Veri sayfasını 5. sayfaya kopyalayacak 9 ise 9. sayfaya kopyalayacak. Necdet hocamın verdiği kod gibi.

Bunu soruyu sorarken söylememiştiniz.Nereden bileceğiz F2 hücresi konusunu?

alicimri · 16 Aralık 2018

Örnek dosya ekte.,
Sonradan fark ettim.
sayfa = Range("f2")
satırını aşağıdaki kod ile değiştirin.
sayfa = CStr(Range("f2"))

https://www.dosyaupload.com/ejhO

recepkull · 16 Aralık 2018

@Orion1 hocam kodda if else komutları olduğu için anlarsınız diye düşünmüştüm özür dilerim benim hatam.

Orion1 · 16 Aralık 2018

recepkull' Alıntı:
@Orion1 hocam kodda if else komutları olduğu için anlarsınız diye düşünmüştüm özür dilerim benim hatam.

Estafurullah.

Makro kodu kısaltma

recepkull

alicimri

alicimri

recepkull

Orion1

Uzman

recepkull

Orion1

Uzman

recepkull

Ziynettin

Destek Ekibi

Necdet

Moderatör

Orion1

Uzman

recepkull

Orion1

Uzman

recepkull

Orion1

Uzman

recepkull

Orion1

Uzman

alicimri

recepkull

Orion1

Uzman