• DİKKAT

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

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

  • Konbuyu başlatan Konbuyu başlatan Filose
  • Başlangıç tarihi Başlangıç tarihi
Katılım
22 Ekim 2012
Mesajlar
311
Excel Vers. ve Dili
Office 2016 Türkçe
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.
 

Ekli dosyalar

Merhaba.

Aşağıdaki kod'u kullanabilirsiniz.
.
Kod:
[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]
 
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.
 
Geri
Üst