Farkli Sayfalari Birlestirme

[bono]

Arkadaslar,

Ben bir makro yazmaya calistim ancak bazi problemlerimi gideremiyorum. Asagida kodunu verecegim makro ile yapmak istedigim sey,

"4YTKON" dosyasından "YTB" altındaki "4" isimli sheete veri aktarmak ve

"14YTKON" dosyasından da yine "YTB" altındaki "14" isimli sheete veri aktarmak.

Sonrada "YTB" altındaki "YT BIR" sheetine "4" ve "14" isimli sheetlerdeki bilgileri alt alta yapıştırmak.


Sorunum aşağıda "buradan sonra hata veriyor" yazdığım yerde başlıyor. "4" isimli sheetteki bilgileri aktarmakta bir sorun olmuyor (ilk satırda başlıklar olduğudnan hiç boşluk olmaması nedeniyle), ancak "14" nolu sheetteki bilgileri altına kopyalamaya çalıştığımda 2.satırdan başlaması gerekiyor (başlıkları almayacak) ve 2.satırda boşluk olan kolon yer alabiliyor. O yüzden boşluk gördüğü yerde bilgi alınımını kesiyor ve tablo tam kopyalanamıyor. Aslında kolonlardaki boşlukları dikkate almaması gerekiyor.

Bu konuda yardımcı olabilirseniz çok sevinirim. Ayrıca benim makrolarım çok iyi yazmayı beceremediğimden çok karışık bunun daha kısa bir yolu olabilirmi? bilmiyorum. Ama öncelikle benim alt alta ekleme problemimi çözmem gerek

İlgilenecek arkadaşlara şimdiden teşekkürler




Sub YTB()

Windows("4YTKON.xls").Activate
Columns("E:F").Select
Selection.Copy
Windows("YTB.xls").Activate
Columns("A:A").Select
ActiveSheet.Paste
Windows("4YTKON.xls").Activate
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("C:C").Select
ActiveSheet.Paste
Windows("4YTKON.xls").Activate
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("D").Select
ActiveSheet.Paste
Windows("4YTKON.xls").Activate
ActiveWindow.SmallScroll ToRight:=6
Columns("P").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("E:E").Select
ActiveSheet.Paste
Windows("4YTKON.xls").Activate
Columns("N:O").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("F:F").Select
ActiveSheet.Paste
Windows("4YTKON.xls").Activate
ActiveWindow.SmallScroll ToRight:=10
Columns("T:T").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("H:H").Select
ActiveSheet.Paste
Windows("4YTKON.xls").Activate
Columns("Z:Z").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("I:I").Select
ActiveSheet.Paste
Windows("4YTKON.xls").Activate
ActiveWindow.SmallScroll ToRight:=8
Columns("AK:AK").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("J:J").Select
ActiveSheet.Paste
Windows("4YTKON.xls").Activate
Columns("AE:AF").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("K:K").Select
ActiveSheet.Paste
Windows("4YTKON.xls").Activate
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("D").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
ActiveWindow.SmallScroll ToRight:=3
Columns("M:M").Select
ActiveSheet.Paste
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Windows("4YTKON.xls").Activate
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Windows("4YTKON.xls").Activate
Columns("K:K").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
ActiveWindow.SmallScroll ToRight:=5
Columns("O:O").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=-5
Range("A1").Select
Sheets("14").Select
Windows("14YTKON.xls").Activate
Columns("E:G").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("A:A").Select
ActiveSheet.Paste
Sheets("14").Select
Windows("14YTKON.xls").Activate
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("D").Select
ActiveSheet.Paste
Sheets("14").Select
Windows("14YTKON.xls").Activate
Columns("D").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("E:E").Select
ActiveSheet.Paste
Sheets("14").Select
Windows("14YTKON.xls").Activate
ActiveWindow.SmallScroll ToRight:=2
Columns("L:L").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("F:F").Select
ActiveSheet.Paste
Windows("14YTKON.xls").Activate
ActiveWindow.SmallScroll ToRight:=3
Columns("M:N").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("G:G").Select
ActiveSheet.Paste
Sheets("14").Select
Windows("14YTKON.xls").Activate
ActiveWindow.SmallScroll ToRight:=4
Columns("P").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("I:I").Select
ActiveSheet.Paste
Sheets("14").Select
Windows("14YTKON.xls").Activate
ActiveWindow.SmallScroll ToRight:=7
Columns("Y:Y").Select
ActiveWindow.SmallScroll ToRight:=-4
Columns("O:O").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("J:J").Select
ActiveSheet.Paste
Windows("14YTKON.xls").Activate
ActiveWindow.SmallScroll ToRight:=2
Columns("U:U").Select
Application.CutCopyMode = False
Selection.Copy
Windows("YTB.xls").Activate
Columns("K:K").Select
ActiveSheet.Paste
Sheets("4").Select
ActiveWindow.SmallScroll ToRight:=5
Windows("14YTKON.xls").Activate
Windows("YTB.xls").Activate
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1

Windows("YTB.xls").Activate
Sheets("4").Select
For x = Range("a65536").End(xlUp).Row To 1 Step -1
If Cells(x, 1) = "" Then Rows(x).Delete
Next

Windows("YTB.xls").Activate
Sheets("14").Select
For x = Range("a65536").End(xlUp).Row To 1 Step -1
If Cells(x, 1) = "" Then Rows(x).Delete
Next

'buradan sonra hata veriyor

Sheets("4").Select
If [d7] <> "" Then

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("YT BIR").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If

Sheets("14").Select
If [d7] <> "" Then

Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("YT BIR").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

End If
End Sub

 

[Levent Menteşoğlu]

Her üç dosyanızında küçük bir örneğini eklermisiniz.

 

[bono]

LEVENTM öncelikle ilgilendiğiniz için teşekkürler. Ben o gün geç saate kadar uğraştım ve sorunu çözdüm. Şu anda çalışıyor görünüyor ama hala bir kaç problemim var. Kendi çalıştığım dosyaların bir kopyasını bazı sakıncalar nedeniyle göndermem mümkün olmadığınan ve örnek dosya hazırlamaya vakit bulamadığımdan henüz gönderemedim. Ama özellikle bir çok arkadaşa çok yararlı olacağını düşündüğüm bu makroyu örnek dosya haline getirerek mutlak göndereceğim. Belki üstünde iyileştirme yapmam için yine yardım edersiniz

syg

 

[Levent Menteşoğlu]

Yukarıdaki verdiğiniz kodu makro kaydet ile elde etmişsiniz bu sebeple içinde çok sayıda düzeltme yapılabilir. Örneğin öncelikle içinde scroll geçen tüm satırları kaldırın.