Bir sayfadan diğer sayfaya Makro ile aktar BOŞ SATIRLAR hariç

[Filose]

Herkese Merhaba,

Sayfalar arası aktarma yapabiliyorum ancak boş satırları aktarmak istemiyorum. Bununla birçok örnek var ama, ekteki dosyama uyarlayamadım.
Çünkü birleştirilmiş hücreler var.

Yardımcı olabilecek arkadaşlara şimdiden çok teşekkür ederim.

 

[Ömer BARAN]

Merhaba.

Aşağıdaki kod'u kullanabilirsiniz.
.

[FONT="Arial Narrow"][B]Sub AKTAR_FILOSE()[/B]
Set l = Sheets("Liste"): Set a = Sheets("Aktar")
If a.[H65536].End(3).Row > 5 Then
With a.Range("H6:AP" & a.[H65536].End(3).Row)
    .ClearContents: .UnMerge
End With: End If
For satır = 7 To l.[Az65536].End(3).Row
If l.Cells(satır, "AZ") > 0 Or l.Cells(satır, "BG") > 0 Then
sat = WorksheetFunction.Max(6, a.[j65536].End(3).Row + 1)
    If l.Cells(satır, "AZ") > 0 And l.Cells(satır, "O") = "" Then
        fsat = satır - 1
    Else: fsat = satır: End If
    a.Range(a.Cells(sat, "H"), a.Cells(sat, "I")).Merge
    a.Range(a.Cells(sat, "J"), a.Cells(sat, "AA")).Merge
    a.Range(a.Cells(sat, "AC"), a.Cells(sat, "AI")).Merge
    a.Range(a.Cells(sat, "AJ"), a.Cells(sat, "AP")).Merge
    a.Cells(sat, "H") = sat - 5: a.Cells(sat, "J") = l.Cells(fsat, "O")
    a.Cells(sat, "AC") = l.Cells(satır, "AZ"): a.Cells(sat, "AJ") = l.Cells(satır, "BG")
End If: Next
[B]End Sub[/B][/FONT]

 

[Filose]

Merhaba Ömer Bey,
Çok teşekkür ederim. Hiç sorun yok sadece LİSTE sayfasındaki firma ismi 2 satır birleştirilerek yazıldığı için,

Aktarıldığı AKTAR sayfasında da aynen yazılabilir mi? Yani 2 defa yazılmak yerine olduğu gibi 2 satırı birleştirsin.

Tekrar teşekkür eder, saygılar sunarım.