Soru Makro ile belirli alanı kopyalayıp belirtilen alana istenilen kadar çoğaltma

[ferhanc]

Merhabalar

Makro ile belirli alanı kopyalayıp belirtilen alana istenilen kadar bir boşluk bırakarak çoğaltmak istiyorum. Daha önce benzer konulara verilmiş cevaplardan denemeler yaptım fakat sonuç alamadım. Aşağıdaki kod 1 defa yan satıra kopyalama yapıyor. Benim istediğim a7 hizasına bir boşluk bırakarak sürekli istenilen kadar yapıştırma işlemi yapacak. Dosyamı ekleme kısmını bulamadığım için ekleyemedim. yardımcı olursanız sevinirim.

Sub kopyala()
Sheets("Sayfa1").Range("A7:B117").copy
sat = Sheets("Sayfa1").Cells(65536, "d").End(xlUp).Row + 2
Sheets("Sayfa1").Range("D" & sat).PasteSpecial
Application.CutCopyMode = False
MsgBox "Yeni Kayıt Açıldı!!"
End Sub

 

[systran]

internette "dosya yükleme", "resim yükleme" olarak aratınız. çıkan siteleri kullanarak yüklediğiniz çalışma ve resimlerin linklerini mesajınızda paylaşınız.
Ayrıca şu konudaki uyarılarıda dikkate alınız.

Örnek Dosya Hazırlarken Dikkat Edilmesi Gerekenler

. . . 1- Örnek dosyanız asıl dosyanın özeti niteliğinde olmalıdır. 2- Dosya formatlarında *.XLS kullanmanızı tavsiye ederim. *.XLS uzantısı 2003 ve üzeri Office sürümlerinde çalışmaktadır. (*.XLSX , *.XLSM gibi uzantılar Office 2003 sürümünde çalışmamaktadır ve 2003 kullanıcı sayısı oldukça...

www.excel.web.tr

 

[ferhanc]

Merhabalar

Makro ile belirli alanı kopyalayıp belirtilen alana istenilen kadar bir boşluk bırakarak çoğaltmak istiyorum. Daha önce benzer konulara verilmiş cevaplardan denemeler yaptım fakat sonuç alamadım. Aşağıdaki kod 1 defa yan satıra kopyalama yapıyor. Benim istediğim a7 hizasına bir boşluk bırakarak sürekli istenilen kadar yapıştırma işlemi yapacak. Dosyamı ekleme kısmını bulamadığım için ekleyemedim. yardımcı olursanız sevinirim.

Sub kopyala()
Sheets("Sayfa1").Range("A7:B117").copy
sat = Sheets("Sayfa1").Cells(65536, "d").End(xlUp).Row + 2
Sheets("Sayfa1").Range("D" & sat).PasteSpecial
Application.CutCopyMode = False
MsgBox "Yeni Kayıt Açıldı!!"
End Sub

Dosya eki
https://dosya.co/jv5itfu0rb4y/New_folder_(2).rar.html

 

[ferhanc]

Konuya yardım edebilecek yok mu

 

[systran]

for döngüsündeki 15 değeri ile oynayıp farklı sayıları deneyiniz.
Sub kopyala()
Sheets("Sayfa1").Range("A7:B117").Copy
For i = 4 To 15 Step 3
Sheets("Sayfa1").Cells(7, i).PasteSpecial
Next i
Application.CutCopyMode = False
MsgBox "Yeni Kayıt Açıldı!!"
End Sub

 

[ferhanc]

Butona bastığımda dosya aç ekranı açarak peşpeşe 4 tane kopyalıyor. Her macro çalıştırıldığında 1 tane çoğaltması gerekiyor.

 

[okinava14]

konuya verilen cevaplar güzel Emeğinize sağlık.

 

[ferhanc]

Merhaba şekilde yazıca doğru alana sadece bir tane ekliyor. Her butona basıldığında bir boşluk atıp eklemeye devam etmesi gerekiyor. Yardımcı olabilecek var mı.

Sub kopyala()
Sheets("Sayfa1").Range("A7:B117").copy
For i = 4 To 5 Step 3
Sheets("Sayfa1").Cells(7, i).PasteSpecial
Next i
Application.CutCopyMode = False
MsgBox "Yeni Kayıt Açıldı!!"
End Sub

 

[çıtır]

Deneyiniz.

Sub kopyaal()
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1")
sst = s1.Cells(65355, "A").End(3).Row
skl = s1.Cells(21, 1000).End(1).Column
s1.Range("A7:B" & sst).Select
Selection.Copy
s1.Cells(7, skl + 2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
MsgBox "Yeni Kayıt Açıldı!!"
End Sub

 

[ferhanc]

Deneyiniz.

Sub kopyaal()
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1")
sst = s1.Cells(65355, "A").End(3).Row
skl = s1.Cells(21, 1000).End(1).Column
s1.Range("A7:B" & sst).Select
Selection.Copy
s1.Cells(7, skl + 2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
MsgBox "Yeni Kayıt Açıldı!!"
End Sub

Çok Teşekkür ederim.

 

[ferhanc]

for döngüsündeki 15 değeri ile oynayıp farklı sayıları deneyiniz.
Sub kopyala()
Sheets("Sayfa1").Range("A7:B117").Copy
For i = 4 To 15 Step 3
Sheets("Sayfa1").Cells(7, i).PasteSpecial
Next i
Application.CutCopyMode = False
MsgBox "Yeni Kayıt Açıldı!!"
End Sub

İlginize teşekkür ederim

 

[çıtır]

Çok Teşekkür ederim.

Rica ederim.Dönüş yaptığınız için teşekkür ederim.