Yardım Sayfalar Arası Kopyalamada Hata

Mikdad · 6 Ağu 2019

Dostlarım, birleştirme Formulunde bir sıkıntı var sanırım, Rapor sayfasında Birleştir dediğim zaman Gss ve Yardım sayfalarındaki boş Satırları da alıyor.
https://dosya.co/r92zg57pjvui/Gündem_Eksik.xlsm.html

Aşağıdakı Kod ta her Sayfanın D sutununa bakıyor. içerisinde veri olan yere kadar kopyalayıp rapor sayfasına yapıştırıyor. buraya kadar bir sorun yok. asıl sorun Yardım, GSS ve GMADDELERİ sayfasında D stunlarında Formul Olması, formul olduğu için bu kodlar formulu de veri olarak görüyor. yani normalde D250 de veriler bitmiş d250 ye kadar kopyalaması lazım. ama ben formulu d300 e kadar çektiğim için d250 den sonrasını yani formullerin içinde yazılı olduğu ama veri olmayan son 50 satırı da kopyalıyor. biz aşağıdaki formule sadece verile al. formul olan satırları görme diyebiliyor muyuz acaba. bu konuda destek olursanız çok sevinirim.

PHP:

Sub SYDV()

Set s1 = Sheets("YARDIM")

Set s2 = Sheets("GSS")

Set s3 = Sheets("Rapor")

Set s4 = Sheets("GMADDELERI")

son1 = WorksheetFunction.Max(s1.Cells(Rows.Count, "D").End(3).Row, 2)

son2 = WorksheetFunction.Max(s2.Cells(Rows.Count, "d").End(3).Row, 2)

son4 = WorksheetFunction.Max(s4.Cells(Rows.Count, "D").End(3).Row, 2)





yeni1 = s3.Cells(Rows.Count, "D").End(3).Row + 1

s1.Range("A2:Z" & son1).Copy: s3.Cells(yeni1, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _

, SkipBlanks:=False, Transpose:=False

s1.Range("A2:Z" & son1).Copy: s3.Cells(yeni1, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False



yeni2 = s3.Cells(Rows.Count, "d").End(3).Row + 1

s2.Range("A2:Z" & son2).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _

, SkipBlanks:=False, Transpose:=False

s2.Range("A2:Z" & son2).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False



yeni3 = s3.Cells(Rows.Count, "D").End(3).Row + 1

s4.Range("A2:Z" & son4).Copy: s3.Cells(yeni3, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _

, SkipBlanks:=False, Transpose:=False

s4.Range("A2:Z" & son4).Copy: s3.Cells(yeni3, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False



MsgBox "İşlem Tamamlandı", vbOKOnly, "SYDV"



End Sub

Yardım Sayfalar Arası Kopyalamada Hata

Mikdad