• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makroyla aktarılan verilerde BOŞ hücre sorunu.

Katılım
7 Haziran 2007
Mesajlar
54
Excel Vers. ve Dili
2003 TR
Sayın Arkadaşlarım ve Hocalarım,

1 haftadır içinden çıkamadığım bir sorunumu paylaşmak istiyorum.

aşağıda örneğini verdiğim makro ile başka bir excel kitabından (A), hazırladığım farklı excel kitabında (B) bir tabloya 1000 satır veri alıyorum. Kaynak A da bin satırın 5 satırı dolu gerisi henüz dolmamış. B ye 1000 satırı aktardığımda görünürde olduğu gibi veri geliyor. Fakat boş görünen alttaki 995 satır doluymuş gibi davranıp, boş hücreye git komutlarımda 1001. satıra gidiyor. Halbuki 6. satırdan itibaren boş olması gerekiyor.

Acaba yanlış bir aktarım makrosu mu kullanıyorum..? makroyla komple 1000 satırı değilde, sadece 1000 satıra kadar olan dolu hücreleri al diyebilirmiyiz..?

Yada 1000 satır aktarıldıktan sonra boş olması gereken satırları otomatik silecek ve gerçekten boş yapacak başka bir makro eklenebilirmi..?

Bu konuda yardımlarınızı rica ediyorum.

Saygılarımla,

Örnek Makrom
Kod:
Sub AKTAR()
Dim Dosya_Yolu As String, Asıl_Dosya As Workbook, Kaynak_Dosya As Workbook
Application.ScreenUpdating = False
Set Asıl_Dosya = ThisWorkbook

Set Kaynak_Dosya = Workbooks.Open("..._Tablosu.xls", False, False)
Kaynak_Dosya.Sheets("Ur_Onay").Range("A3:V1000").Copy
Asıl_Dosya.Activate

Range("A3:V1000").PasteSpecial (xlPasteValuesAndNumberFormats) 
Application.CutCopyMode = False
Kaynak_Dosya.Close True
Set Kaynak_Dosya = Nothing
Set Asıl_Dosya = Nothing
Application.ScreenUpdating = True

End Sub
 
Aşağıdaki gibi deneyin.

Kod:
Sub AKTAR()
Dim Dosya_Yolu As String, Asıl_Dosya As Workbook, Kaynak_Dosya As Workbook
Application.ScreenUpdating = False
Set Asıl_Dosya = ThisWorkbook
 
Set Kaynak_Dosya = Workbooks.Open("..._Tablosu.xls", False, False)
[COLOR=red]sonsat=Kaynak_Dosya.Sheets("Ur_Onay").Range("A65536").end(3).row[/COLOR]
Kaynak_Dosya.Sheets("Ur_Onay").Range("A3:V" [COLOR=red]& sonsat[/COLOR]).Copy
Asıl_Dosya.Activate
 
[COLOR=red]Range("A3").[/COLOR]PasteSpecial (xlPasteValuesAndNumberFormats) 
Application.CutCopyMode = False
Kaynak_Dosya.Close True
Set Kaynak_Dosya = Nothing
Set Asıl_Dosya = Nothing
Application.ScreenUpdating = True
 
End Sub
 
Levent Hocam merhaba,

Hızlı yanıtınız için çok teşekkür ederim. Verdiğiniz örneği denedim fakat sonuç aynı. 1000 satıra kadar dolu gibi görüyor hücreleri. 1001. satırdan itibaren boş diyor.

Fakat şu detay var. Kaynak dosyada ki 1000 satır EĞER formüllü ve sonucları "" şeklinde. Sizin makroya eklediğiniz Range("A65536").end(3).row bu hücreleri boş olarak görmüyor olabilirmi..?

Bu kısımda yapılacak "" tanımlaması işimizi çözebilirmi hocam sizce..?
 
Eğer ilgili sayfada formül varsa bunu veri olarak görür. A sütunundaki veri tipi nedir?, Ayrıca formülller sonucu sıfırmı yoksa boş olarakmı gösteriyor?
 
aynı alana daha önce kopyalama yaptığınız için olabilir.
 
Levent hocam denedim fakat aynı. Değişen birşey olmadı. :(

Acaba BOŞ hücre demesekde, A sütünunda ilk "" yüklü hücreye kadar kopyala desek olabilirmi.
 
Eğer ilgili sayfada formül varsa bunu veri olarak görür. A sütunundaki veri tipi nedir?, Ayrıca formülller sonucu sıfırmı yoksa boş olarakmı gösteriyor?
 
Eğer ilgili sayfada formül varsa bunu veri olarak görür. A sütunundaki veri tipi nedir?, Ayrıca formülller sonucu sıfırmı yoksa boş olarakmı gösteriyor?

Hoca kaynak dosya A sütünundaki formül bu :
Kod:
=EĞER(M4="Onaylandi";Ur_Siparis_Onay!A4;"")

bu formül sonucunda hücre boş görünüyor.
 
Ur_Siparis_Onay!A4 hücresindeki veri tipi nedir? yani sayısalmı yoksa metinmi?
 
Hocam A sütünu referans numarası olarak kullanıyorum ve "UR10001" den başlıyor aşağı doğru artarak gidiyor.
 
Aşağıdaki gibi deneyin.

Kod:
Sub AKTAR()
Dim Dosya_Yolu As String, Asıl_Dosya As Workbook, Kaynak_Dosya As Workbook
Application.ScreenUpdating = False
Set Asıl_Dosya = ThisWorkbook
 
Set Kaynak_Dosya = Workbooks.Open("..._Tablosu.xls", False, False)
[COLOR=red]sonsat=WorksheetFunction.CountIf(Kaynak_Dosya.Sheets("Ur_Onay").Range("A3:A65536"), ">A") + 2[/COLOR]
Kaynak_Dosya.Sheets("Ur_Onay").Range("A3:V" [COLOR=red]& sonsat[/COLOR]).Copy
Asıl_Dosya.Activate
 
[COLOR=red]Range("A3").[/COLOR]PasteSpecial (xlPasteValuesAndNumberFormats) 
Application.CutCopyMode = False
Kaynak_Dosya.Close True
Set Kaynak_Dosya = Nothing
Set Asıl_Dosya = Nothing
Application.ScreenUpdating = True
 
End Sub
 
Aşağıdaki gibi deneyin.

Kod:
Sub AKTAR()
Dim Dosya_Yolu As String, Asıl_Dosya As Workbook, Kaynak_Dosya As Workbook
Application.ScreenUpdating = False
Set Asıl_Dosya = ThisWorkbook
 
Set Kaynak_Dosya = Workbooks.Open("..._Tablosu.xls", False, False)
[COLOR=red]sonsat=WorksheetFunction.CountIf(Kaynak_Dosya.Sheets("Ur_Onay").Range("A3:A65536"), ">A") + 2[/COLOR]
Kaynak_Dosya.Sheets("Ur_Onay").Range("A3:V" [COLOR=red]& sonsat[/COLOR]).Copy
Asıl_Dosya.Activate
 
[COLOR=red]Range("A3").[/COLOR]PasteSpecial (xlPasteValuesAndNumberFormats) 
Application.CutCopyMode = False
Kaynak_Dosya.Close True
Set Kaynak_Dosya = Nothing
Set Asıl_Dosya = Nothing
Application.ScreenUpdating = True
 
End Sub

Hocam Süpersin!!! :) Valla oldu... Ellerinize sağlık.

Son bir bilgi danışacağım müsade ederseniz.

Yukarıda ki makro ya nasıl bir eklenti yapmalıyım ki 2. bir kaynaktan aldığı veriyi bu tablonun en altındaki boş hücreden başlayarak altına eklesin.

kaynak 1 den 6 satır getiriyorsa, kaynak 2 de ki veriler 7. satırdan başlasın. Böyle birşey mümkün mü acaba...

Çok teşekkür ediyorum ilginize.
Saygılarımla,
 
Rica ederim. Aşağıdaki gibi bir eklemede sanıyorum ikinci sorununuzu çözecektir.

Kod:
Sub AKTAR()
Dim Dosya_Yolu As String, Asıl_Dosya As Workbook, Kaynak_Dosya As Workbook
Application.ScreenUpdating = False
Set Asıl_Dosya = ThisWorkbook
 
Set Kaynak_Dosya = Workbooks.Open("..._Tablosu.xls", False, False)
[COLOR=black]sonsat=WorksheetFunction.CountIf(Kaynak_Dosya.Sheets("Ur_Onay").Range("A3:A65536"), ">A") + 2[/COLOR]
[COLOR=black]Kaynak_Dosya.Sheets("Ur_Onay").Range("A3:V" & sonsat).Copy[/COLOR]
Asıl_Dosya.Activate
[COLOR=red]sonsat1=[/COLOR][COLOR=#ff0000]WorksheetFunction.CountA(range("a3:a65536"))+3[/COLOR]
[COLOR=red]Range("A" & sonsat1).[/COLOR]PasteSpecial (xlPasteValuesAndNumberFormats) 
Application.CutCopyMode = False
Kaynak_Dosya.Close True
Set Kaynak_Dosya = Nothing
Set Asıl_Dosya = Nothing
Application.ScreenUpdating = True
End Sub
 
Rica ederim. Aşağıdaki gibi bir eklemede sanıyorum ikinci sorununuzu çözecektir.

Kod:
Sub AKTAR()
Dim Dosya_Yolu As String, Asıl_Dosya As Workbook, Kaynak_Dosya As Workbook
Application.ScreenUpdating = False
Set Asıl_Dosya = ThisWorkbook
 
Set Kaynak_Dosya = Workbooks.Open("..._Tablosu.xls", False, False)
[COLOR=black]sonsat=WorksheetFunction.CountIf(Kaynak_Dosya.Sheets("Ur_Onay").Range("A3:A65536"), ">A") + 2[/COLOR]
[COLOR=black]Kaynak_Dosya.Sheets("Ur_Onay").Range("A3:V" & sonsat).Copy[/COLOR]
Asıl_Dosya.Activate
[COLOR=red]sonsat1=[/COLOR][COLOR=#ff0000]WorksheetFunction.CountA(range("a3:a65536"))+3[/COLOR]
[COLOR=red]Range("A" & sonsat1).[/COLOR]PasteSpecial (xlPasteValuesAndNumberFormats) 
Application.CutCopyMode = False
Kaynak_Dosya.Close True
Set Kaynak_Dosya = Nothing
Set Asıl_Dosya = Nothing
Application.ScreenUpdating = True
End Sub

2. kaynak dosyayı ve ilgili sayfasını yukarıdaki dizenin neresine eklemem gerekiyor hocam.
 
Tamam hallettim hocam :)

Yardımlarınız için tekrardan teşekkürler.

Saygılarımla,
 
Geri
Üst