Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 02-02-2017, 01:52   #1
kemalist
Altın Üye
 
kemalist kullanıcısının avatarı
 
Giriş: 04/06/2008
Şehir: ESKİŞEHİR
Mesaj: 671
Excel Vers. ve Dili:
Excel 2016
Varsayılan Makro ile kopyalama

Arkadaşlar Merhaba;Benim yapmak istediğim elimde "DATA" isminde bir dosya var.Burada B4 hücresinde bulunan "R" sayfasından "B4:B403" hücrelerini kopyalayıp "N4" hücresindeki "A" sayfasında "CE6 ve CV6 "ya PasteSpacial olarak yapıştırmak. Kopyalanacak ve yapıştırılacak hücreleri bu sayfadan seçmek gerekli.Devamındada aynı işlemi Next döngüsüyle alt satırlara uygulamak.Bunu makro ile nasıl yapabiliriz?İlginiz için şimdiden teşekkür ederim.Örnek dosya ektedir.
Eklenmiş Dosyalar
Dosya Türü: xlsx DATA.xlsx (32.4 KB, 8 Görüntülenme)
kemalist Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-02-2017, 03:35   #2
vardar07
Destek Ekibi
 
vardar07 kullanıcısının avatarı
 
Giriş: 19/03/2008
Şehir: Kepez / ANTALYA
Mesaj: 2,154
Excel Vers. ve Dili:
Office 2007 Enterprise Türkçe
Varsayılan

Yanlış anlamadıysam. Deneyiniz.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub aktar()
With Sheets("Sayfa1")
For m = 4 To 8
c = .Cells(m, "B"): d = .Cells(m, "N")
Set sk = Sheets(c): Set sy = Sheets(d)
a = .Cells(m, "I") & ":" & .Cells(m, "K")
b = .Cells(m, "V") & ":" & .Cells(m, "X")
sk.Range(a).Copy sy.Range(b)
Next m
End With
End Sub
__________________
Veren El Alan Elden EVLA'dır...

Örnek excel dosyanızı,açıklamalarını da yazarak; UPTERABİT.COM, DOSYA.TC, DOSYA.CO gibi dosya paylaşım sitelerine ekleyip linkini burada bildirirseniz yardım almanız daha kolay olur.

Özel mesajlarda sorulan sorulara cevap vermiyorum.
vardar07 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-02-2017, 10:36   #3
kemalist
Altın Üye
 
kemalist kullanıcısının avatarı
 
Giriş: 04/06/2008
Şehir: ESKİŞEHİR
Mesaj: 671
Excel Vers. ve Dili:
Excel 2016
Varsayılan

Sayın Vardar07 "Outoff Range " olarak hata veriyor.Siz örnek dosya üzerinde denermisiniz?
kemalist Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-02-2017, 13:15   #4
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,230
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Merhaba.

Aşağıdaki kod'u kullanabilirsiniz.
.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub KOPYALA()
Set s1 = Sheets("Sayfa1")
For sat = 4 To s1.[B65536].End(3).Row
'*** k kısaltması KAYNAK anlamında, h kısaltması ise HEDEF anlamındadır.
On Error GoTo 10
    Set ksayfa = Sheets(s1.Cells(sat, "B").Value)
        kilk = s1.Cells(sat, "I").Value
        kson = s1.Cells(sat, "K").Value
    
    Set hsayfa = Sheets(s1.Cells(sat, "N").Value)
        hbir = s1.Cells(sat, "V").Value
        hiki = s1.Cells(sat, "X").Value
    ksayfa.Range(kilk & ":" & kson).Copy: hsayfa.Range(hbir).PasteSpecial Paste:=xlPasteValues
    ksayfa.Range(kilk & ":" & kson).Copy hsayfa.Range(hiki).PasteSpecial Paste:=xlPasteValues
10
Next: ksayfa = Empty: hsayfa = Empty
MsgBox "İşlem tamamlandı..", vbInformation, "..:: O.BARAN ::.."
End Sub
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-02-2017, 13:28   #5
vardar07
Destek Ekibi
 
vardar07 kullanıcısının avatarı
 
Giriş: 19/03/2008
Şehir: Kepez / ANTALYA
Mesaj: 2,154
Excel Vers. ve Dili:
Office 2007 Enterprise Türkçe
Varsayılan

Alıntı:
kemalist tarafından gönderildi Mesajı Görüntüle
Sayın Vardar07 "Outoff Range " olarak hata veriyor.Siz örnek dosya üzerinde denermisiniz?
Onun sebebi N8 hücresindeki E harfinin sağında boşluk varmış ondan oluyor.
Bu satırı aşağıdaki ile değiştirin. Yada E harfinin sağındaki boşluğu silip deneyin.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
c = .Cells(m, "B"): d = .Cells(m, "N")
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
c = Trim(.Cells(m, "B")): d = Trim(.Cells(m, "N"))
__________________
Veren El Alan Elden EVLA'dır...

Örnek excel dosyanızı,açıklamalarını da yazarak; UPTERABİT.COM, DOSYA.TC, DOSYA.CO gibi dosya paylaşım sitelerine ekleyip linkini burada bildirirseniz yardım almanız daha kolay olur.

Özel mesajlarda sorulan sorulara cevap vermiyorum.
vardar07 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-02-2017, 13:31   #6
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,230
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Aynen Sayın vardar haklıdır.
Kolay gelsin.
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-02-2017, 13:33   #7
kemalist
Altın Üye
 
kemalist kullanıcısının avatarı
 
Giriş: 04/06/2008
Şehir: ESKİŞEHİR
Mesaj: 671
Excel Vers. ve Dili:
Excel 2016
Varsayılan

Ömer Bey Merhaba ilginize teşekkür ederim.Tek eksiğimiz en alt satırı yani sayfa1 deki 8. satırdakilere uygulamıyor.
kemalist Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-02-2017, 13:37   #8
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,230
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Son satırda N8 hücresindeki E harfinden sonraki boşluk karakteri ile ilgili olarak,
Sayın vardar'ın son cevabındaki uyarıyı dikkate alınız.
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-02-2017, 13:39   #9
kemalist
Altın Üye
 
kemalist kullanıcısının avatarı
 
Giriş: 04/06/2008
Şehir: ESKİŞEHİR
Mesaj: 671
Excel Vers. ve Dili:
Excel 2016
Varsayılan

Alıntı:
vardar07 tarafından gönderildi Mesajı Görüntüle
Yanlış anlamadıysam. Deneyiniz.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub aktar()
With Sheets("Sayfa1")
For m = 4 To 8
c = .Cells(m, "B"): d = .Cells(m, "N")
Set sk = Sheets(c): Set sy = Sheets(d)
a = .Cells(m, "I") & ":" & .Cells(m, "K")
b = .Cells(m, "V") & ":" & .Cells(m, "X")
sk.Range(a).Copy sy.Range(b)
Next m
End With
End Sub
sayın vardar07 yapıştırma işlemi iki ayrı kücreye olacak burada iki hücre arasındaki tüm hücrelere yapıyor. Dikkat edilirse hücreler arasını ; (noktalı virgül) ile belirtmiştim.
kemalist Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-02-2017, 14:20   #10
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,230
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Sayın kemalist,
-- N8 hücresindeki boşluk karakterini silerek
-- veya
Set hsayfa = Sheets(s1.Cells(sat, "N").Value)
satırını
Set hsayfa = Trim(Sheets(s1.Cells(sat, "N").Value))
şeklinde değiştirerek
benim gönderdiğim kod'u kullanabilirsiniz.
.
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 04:05


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri- Çorlu Çelik Konstruksiyon-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden