Birleştirilmiş hücreleri aktarma

[ormann]

Arkadaşlar örnek verecek olursak "a1,b1,c1" hücrelerini birşeştirdiğimiz zaman başka bir sayfada "a1" " hücresine bu birleşenleri aktarabilirmiyiz .Böyle bir makro uygulaması varmıdır ? saygılar

 

[poetisch]

Örnek Excel gönderirsen yardımsı olalım.

 

[ormann]

ekteki dosyada sarı renkli hücreler aktarılan sayfada a1 hücresine aktarılacak.

 

[ormann]

sayın arkadaşlar 1.nolu mesajıma yardımcı olacak arkadaş yokmu

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki şekilde aktarabilirsiniz.

Option Explicit
 
Sub AKTAR()
    Sheets("aktarılansayfa").Range("A1").Value = Sheets("veri").Range("B5:D11").Value
End Sub

 

[ormann]

Sayın korhan bey merhaba:
Aktarma işlemini dediğiniz şekilde yaptım.ancak verileri geri çağırdığımda ise şu hatayı veriyo :"bu işlem için birleştirilmiş hücrelerin aynı boyutta olması gerekli diyo" bu sorunu nasıl çözeriz.yardımcı olurmusunuz.saygılar

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki yöntemle işlemi tersine çevirip denedim. Veri ilgili birleşmiş hücreye aktarıldı. Sizde denermisiniz.

Option Explicit
 
Sub AKTAR()
    Sheets("veri").Range("B5").Value = Sheets("aktarılansayfa").Range("A1").Value
End Sub

 

[ormann]

Teşekkür ederim sayın hocam

 

[ormann]

sayın hocam tekrar bir hata verdi aktardığım zaman veriler aktarılıyo.ama c3,d3,e3,g3,h3 hücrelerinden çağırmak istediğim zaman ise hata veriyo.dosyayı gönderiyorum.yardımcı olursanız memnun kalırım

 

[Korhan Ayhan]

Selamlar,

Siz kopyala-yapıştır yöntemi ile verileri geri çağırıyorsunuz. Bu şekilde kodunuzun hata vermesi normaldir. Aşağıdaki kodu dosyanızdaki eski kod ile değiştirip deneyiniz.

Yaptığım değişkliği kırmızı renkle belirttim.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim yer As Worksheet
    Dim bul As Range
    Dim sat As Integer
    If Target.Count > 1 Then Exit Sub
    If Target = "" Then Exit Sub
    If Intersect(Target, Range("C3,D3,E3,F3,G3,H3")) Is Nothing Then Exit Sub
    Set yer = Sheets("SUÇ KAYDI")
    Set bul = yer.Cells.Find(Target, , xlValues, xlWhole)
    If bul Is Nothing Then
        MsgBox "ÜZGÜNÜM ARADIĞINIZ KAYDI BULAMADIM !!!!!!!!!!!!!!!", vbInformation, "[EMAIL="Alidogan5557@hotmail.com"]Alidogan5557@hotmail.com[/EMAIL]"
        Exit Sub
    Else
        sat = bul.Row
    End If
    yer.Range("A" & sat & ":L" & sat).Copy
    Range("D5").PasteSpecial xlPasteValues, , , True
    yer.Range("O" & sat & ":S" & sat).Copy
    Range("D17").PasteSpecial xlPasteValues, , , True
    yer.Range("V" & sat & ":Y" & sat).Copy
    Range("D22").PasteSpecial xlPasteValues, , , True
    yer.Range("AM" & sat & ":AP" & sat).Copy
    Range("D25").PasteSpecial xlPasteValues, , , True
[COLOR=red]    Range("F14").Value = yer.Range("BY" & sat & ":BY" & sat).Value[/COLOR]
    
    Application.CutCopyMode = False
    Range("D5").Activate
End Sub

 

[ormann]

hocam siz muhteşemsiniz ya.allah razı olsun sizden .