• DİKKAT

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

Seçili alandaki boş hücrelere bir üst hücreyi kopyalama

  • Konbuyu başlatan Konbuyu başlatan bcepni
  • Başlangıç tarihi Başlangıç tarihi
Katılım
16 Ekim 2011
Mesajlar
6
Excel Vers. ve Dili
2007 türkçe
Selamlar, excelde boş olan hücrelere makro ile bir üstteki hücrede yazan değeri kopyalamak istiyorum fakat, hangi alanlarda makro çalışacağını makronun kodunda değil excel üzerinde hangi hücreleri seçili haldeyken makroyu çalıştırırsam o hücrelere uygulaması gerekli fakat bir türlü bulamadım/yapamadım.

yardımcı olursanız sevinirim..
 
Selamlar, excelde boş olan hücrelere makro ile bir üstteki hücrede yazan değeri kopyalamak istiyorum fakat, hangi alanlarda makro çalışacağını makronun kodunda değil excel üzerinde hangi hücreleri seçili haldeyken makroyu çalıştırırsam o hücrelere uygulaması gerekli fakat bir türlü bulamadım/yapamadım.

yardımcı olursanız sevinirim..

Merhaba,

Kodları module kopyalayın ve çalışma kitabını kaydetip kapatın.

Bu işlemden sonra kitabı açtığınız zaman, fare sağ kilik menüsüne ""Yeni--->Y.Kopyala"
adın da yeni bir seçenek eklendiğini görebilirsiniz.

Herhangi bir alanı seçip sağ klik yaptıktan sonra bu seçeneği işaretlediğiniz de seçili alanın üst satırındaki veriler seçili alana gelir.

Kod:
Sub Auto_Open()
     FareMenu
End Sub
 
 Sub FareMenu()
 
     Dim cb As CommandBar, MenuObject
 
    Set cb = Application.CommandBars("Cell")
    Set MenuObject = cb.Controls.Add(Type:=msoControlButton, Temporary:=True)
 
     With MenuObject
             .OnAction = "Kopya"
             .FaceId = 9
             .Caption = "Yeni--->Y.Kopyala"
     End With
 
     Set cb = Nothing: Set MenuObject = Nothing
 
End Sub
 
Sub Kopya()
 
    Dim hucre As Range
 
    Application.ScreenUpdating = False
    On Error Resume Next 
 
    For Each hucre In Selection
        With hucre
            .Value = .Offset(-1, 0)
        End With
    Next hucre
 
    Application.ScreenUpdating = True
 
End Sub
 
 Sub Auto_Close()
     Application.CommandBars("Cell").Reset
 End Sub

.
 
ilginiz için teşekkürler fakat bu makro işimi tam olarak çözmüyor, örnek dosya ektedir bu şekilde birşey yapabilecek makro arıyorum, aslında çok zor olmasa gerek ama bulamadım bir türlü.
 

Ekli dosyalar

Bu şekilde buldum fakat dediğim gibi makro vba kodu lazım :(
 
Aslında Ömer Bey tamda sizin istediğinizi yapmış, ama siz yanlış anlatınca istediğinizi bulamamışsınız...

Buyrun o zaman, deneyiniz..

Kod:
Sub Emre()
    Dim i As Integer
    For i = 2 To 17
    If IsEmpty(Cells(i, 1)) Then Cells(i, 1) = Cells(i - 1, 1)
    If IsEmpty(Cells(i, 2)) Then Cells(i, 2) = Cells(i - 1, 2)
    Next i: i = Empty
End Sub
 
Son düzenleme:
Aslında Ömer Bey tamda sizin istediğinizi yapmış, ama siz yanlış anlatınca istediğinizi bulamamışsınız...

Buyrun o zaman, deneyiniz..

Kod:
Sub Emre()
    Dim i As Integer
    For i = 2 To 17
    If IsEmpty(Cells(i, 1)) Then Cells(i, 1) = Cells(i - 1, 1)
    If IsEmpty(Cells(i, 2)) Then Cells(i, 2) = Cells(i - 1, 2)
    Next i: i = Empty
End Sub

Bu işe yarıyor fakat şu şekilde birşeye ihtiyacım var, 2 to 17 yerinin sabit değil hangi hücreleri seçili haldeyse makroyu çalıştırdığımda onlara uygulamasını istiyorum, şuan C50 ve D70 arasını yapmak istediğim yapmıyor gibi. Bunun bu şekilde kısıtlamalı değil seçtiğim alan nerde olursa olsun sadece oraya uygulamasını istiyorum ama bir türlü olmadı :/

ilginiz için çok teşekkürler yine de yardımlarınızı bekliyorum.
 
■ Uyarı ! Bir üstteki mesaja yanıt vermek için ALINTI yapmanıza gerek yok, gereksiz yer kaplıyor sadece...

Neden orjinal dosyayı eklemiyorsunuz ?

Yanıt: 2 to 17 yerine Activecell.row to işlemi kaç satırda yapmak istiyorsanız onu yazın...

Not: Ben size Ömer Bey'in kodları tavsiye edeceğim gibi bir his var içimde... :)
 
Kusura bakmayın forumda yeni sayılırım da :)

mesela aşağıdaki kod ile seçtiğim alandaki harfleri büyük harflere dönüştürebiliyorum, aynı şekilde yapmak istiyorum fakat bir türlü yapamadım :/

Kod:
Public Sub BUYUK_HARF_YAP()
  Dim oRange As Range
  Dim oCell As Range
  Set oRange = Selection
  For Each oCell In oRange
    oCell.Value = UCase(oCell.Value)
  Next
  
End Sub
 

Ekli dosyalar

Son düzenleme:
Merhaba,

Aşağıdaki kodu denermisiniz.

Kod:
Option Explicit
 
Sub DOLDUR()
    Dim Hücre As Range
    
    For Each Hücre In Selection
        If Hücre.Value = "" Then
            If Hücre.Offset(-1, 0) <> "" Then
                Hücre.Value = Hücre.Offset(-1, 0).Value
            End If
        End If
    Next
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Korhan Ayhan bey çok teşekkürler, yapmak istediğim tam olarak buydu :)
 
Merhaba

Aynı işlemi hücre olarak sağ tarafa taşıması işlemini nasıl yapabiliriz? Örneğin hücre üstündeyken bu hücredeki veriyi 1 sağ taraftaki hücreye nasıl kes-yapıştır ile alabiliriz?
 
Geri
Üst