Makro kodu kısaltma

recepkull

recepkull

Katılım
14 Kasım 2017
Mesajlar
618
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
07-01-2024
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
 
A

alicimri

Katılım
12 Aralık 2015
Mesajlar
1,207
Excel Vers. ve Dili
Türkçe Ofis 2007
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.
 
Son düzenleme:
A

alicimri

Katılım
12 Aralık 2015
Mesajlar
1,207
Excel Vers. ve Dili
Türkçe Ofis 2007
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

recepkull

Katılım
14 Kasım 2017
Mesajlar
618
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
07-01-2024
İ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

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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.
Genişletmek için tıkla ...
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.:cool:
Kod: 
Sheets("Sayfa2").Range("A1:A10").Copy Sheets("Sayfa3").Range("B1")
 
recepkull

recepkull

Katılım
14 Kasım 2017
Mesajlar
618
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
07-01-2024
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

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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.
Genişletmek için tıkla ...
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.:cool:
 
recepkull

recepkull

Katılım
14 Kasım 2017
Mesajlar
618
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
07-01-2024
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
 
Z

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,111
Excel Vers. ve Dili
office2010
Bu olabilir mi?

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

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,436
Excel Vers. ve Dili
Ofis 365 Türkçe
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

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
For i = 1 to 10 Yukarıdaki 10 yazan yere 370 yazınız.:cool:
Kodlar aşağıdadır.:cool:
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

recepkull

Katılım
14 Kasım 2017
Mesajlar
618
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
07-01-2024
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

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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.
Genişletmek için tıkla ...
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.:cool:
 
recepkull

recepkull

Katılım
14 Kasım 2017
Mesajlar
618
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
07-01-2024
@Orion1 hocam bu saatte benim sorunumla ilgilendiğin için gerçekten çok teşekkür ederim Allah razı olsun.
 
recepkull

recepkull

Katılım
14 Kasım 2017
Mesajlar
618
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
07-01-2024
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

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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.
Genişletmek için tıkla ...
Bunu soruyu sorarken söylememiştiniz.Nereden bileceğiz F2 hücresi konusunu?
 
recepkull

recepkull

Katılım
14 Kasım 2017
Mesajlar
618
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
07-01-2024
@Orion1 hocam kodda if else komutları olduğu için anlarsınız diye düşünmüştüm özür dilerim benim hatam.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst