Makro ile sütundaki dolu hücreleri kopyalamak

Katılım
16 Eylül 2023
Mesajlar
8
Excel Vers. ve Dili
excel 2019
Herkese merhaba iyi forumlar,

Farklı bir excel dosyasından hücre kopyalacağım ancak almak istediğim sütundaki sadece dolu hücreleri almak istiyorum.

Mesela D sütununda 5. satırın altındaki sadece dolu dosyaları kopyala diyebileceğim bir makro istiyorum.

Mevcuttaki makrom:
kaynak.ActiveSheet.Range("D5").Copy ThisWorkbook.ActiveSheet.Range("urunkodlari")

Yardım eden arkadaşlara teşekkür ederim.
 
Katılım
12 Aralık 2015
Mesajlar
1,207
Excel Vers. ve Dili
Türkçe Ofis 2007
Kaynak dosyadaki verileriniz liste halinde ve aralarda boş satırlar yoks ise CurrentRegion kullanarak
kaynak.ActiveSheet.Range("D5").CurrentRegion.Copy ThisWorkbook.ActiveSheet.Range("urunkodlari")
Kaynak dosyadaki verileriniz dağınık bir durumda ise dosyaların durumunu görmek gerek.
tcdosya gibi dosya bir paylaşım sitesine örnek dosya ekleyin.
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Merhaba.

Kod:
kaynak.ActiveSheet.Range("D5:D" & Rows.Count).SpecialCells(xlCellTypeConstants, 23).Copy ThisWorkbook.ActiveSheet.Range("urunkodlari")
 
Katılım
12 Aralık 2015
Mesajlar
1,207
Excel Vers. ve Dili
Türkçe Ofis 2007
Veriler dağınık ise
Kod:
adr = Split(kaynak.ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 23).Address, ":")
kaynak.ActiveSheet.Range(adr(0) & ":" & adr(UBound(adr))).copy ThisWorkbook.ActiveSheet.Range("urunkodlari")
 
Katılım
16 Eylül 2023
Mesajlar
8
Excel Vers. ve Dili
excel 2019
Katılım
16 Eylül 2023
Mesajlar
8
Excel Vers. ve Dili
excel 2019
Merhaba teşekkür ederim ilginiz için

Kopyalanacak excelin linki :

Yapıştırılacak makrolu excel linki :
Yapıştırılacak olan satırların altında boşluklar olması gerekiyor yapıştırırken boşluk nasıl bırakabilirim bana bir yol gösterebilir misiniz ?
Yapıştıracağım hücrelere ad tanımladım ancak bu eylem çoklu seçimlerde çalışmaz hatası alıyorum.
 
Katılım
12 Aralık 2015
Mesajlar
1,207
Excel Vers. ve Dili
Türkçe Ofis 2007
Ad tanımlama yapmanız gerekmez. Aşağıdaki kod işinize yarayabilir.
Kod:
Sub aktar()
son = kaynak.ActiveSheet.Cells(Rows.Count, 4).End(3).Row
bas = 7
For i = 5 To son
ThisWorkbook.ActiveSheet.Cells(bas, 9).Value = kaynak.ActiveSheet.Cells(i, 4).Value
bas = bas + 2
Next
End Sub
 
  • Beğen
Reactions: hby
Katılım
12 Aralık 2015
Mesajlar
1,207
Excel Vers. ve Dili
Türkçe Ofis 2007
bas = 7 satırını
bas = 17 olarak değiştirin yanlış yazmışım.
 
  • Beğen
Reactions: hby
Üst