• DİKKAT

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

makroya hücreden veri almak

M

muhsar

Altın Üye
Katılım
16 Mart 2019
Mesajlar
281
Excel Vers. ve Dili
2010 tütkçe
merhaba;ekte sunduğum çalışma kitabımın hbys isimli sayfasında istatistik verisi almaktayım.diğer çalışma kitaplarında ay ismine göre açılmış sayfalardan veri saydırarak istatistik çıkartıyorum.makro kaydet ile yapmış olduğum sayfa değişim isimli makro ile ay değiştiği zaman diğer ay için veri çekeceği sayfa ismini makroda değiştiriyorum.yapmak istediğim makroda ay isminin geçtiği yeri hbys isimli sayfanın v2--w2 hücrelerinden aldırmak,

örneğin;
Selection.Replace What:="eylül_2019", Replacement:="ekim_2019", LookAt:= satırdaki eylül_2019 u hbys sayfasındaki v2 hücresinden alması ekim_2019 u da w2 den alması
ilginiz için şimdiden teşekkür ediyorum:

giriş kullanıcı adı: muharrm şifre:1111

Kod: 
Sub sayfadegisim()
'
' safya degisim Makro
'

'
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
    Range("T23:U26,N34:S37,V34:V37").Select
    Range("V34").Activate
    ActiveWindow.SmallScroll Down:=25
    Range("T23:U26,N34:S37,V34:V37,S66:T67").Select
    Range("S66").Activate
    Selection.Replace What:="eylül_2019", Replacement:="ekim_2019", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveWindow.ScrollRow = 47
    ActiveWindow.ScrollRow = 40
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 1
    ActiveWindow.SmallScroll Down:=22
    Range("T34,T34:U37").Select
    ActiveWindow.SmallScroll Down:=27
    Range("T34,T34:U37,N66:N67,P66:Q67").Select
    Range("P66").Activate
    Selection.Replace What:="agustos_2019", Replacement:="eylül_2019", LookAt _
        :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveWindow.ScrollRow = 53
    ActiveWindow.ScrollRow = 47
    ActiveWindow.ScrollRow = 40
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 27
    Application.DisplayAlerts = True
        Application.EnableEvents = True
    Application.ScreenUpdating = Tru
End Sub
 

Ekli dosyalar

Son düzenleme:
Merhaba,
Aşağıdaki biçimde deneyiniz.
Rich (BB code): 
Selection.Replace What:=Sheets("hbys").Range("V2").Text, Replacement:=Sheets("hbys").Range("W2").Text
 
Alternatif
secili alanları kontrol edip deneyin.

Kod: 
Dim ikinci1 As String, ikinci2 As String

Set ws = Sheets("HBYS")
ilk1 = ws.Range("V1").Text
ilk2 = ws.Range("W1").Text
ikinci1 = ws.Range("V2").Text
ikinci2 = ws.Range("W2").Text


ws.Range("T23:U26,N34:S37,V34:V37,S66:T67").Replace What:=ilk1, Replacement:=ilk2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

ws.Range("T34:U37,N66:N67,P66:Q67").Replace What:=ikinci1, Replacement:=ikinci2, LookAt _
        :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Set ws = Nothing

        
End Sub
 
ÖmerBey' Alıntı:
Merhaba,
Aşağıdaki biçimde deneyiniz.
Rich (BB code): 
Selection.Replace What:=Sheets("hbys").Range("V2").Text, Replacement:=Sheets("hbys").Range("W2").Text
Genişletmek için tıkla ...
çok teşekkür ederim,elinize sağlık,kod
:=xlPart
burayı gösterir hata verdi fakat sayın suskunun verdiği kodlar işimi gördü,çok teşekkür
 
Suskun' Alıntı:
Alternatif
secili alanları kontrol edip deneyin.

Kod: 
Dim ikinci1 As String, ikinci2 As String

Set ws = Sheets("HBYS")
ilk1 = ws.Range("V1").Text
ilk2 = ws.Range("W1").Text
ikinci1 = ws.Range("V2").Text
ikinci2 = ws.Range("W2").Text


ws.Range("T23:U26,N34:S37,V34:V37,S66:T67").Replace What:=ilk1, Replacement:=ilk2, LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

ws.Range("T34:U37,N66:N67,P66:Q67").Replace What:=ikinci1, Replacement:=ikinci2, LookAt _
        :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Set ws = Nothing

       
End Sub
Genişletmek için tıkla ...

çok teşekkür ederim elinize sağlık,bu kodları baştaki tanımlamayı yaparak diğer çalışmalarımda da kullanabilirim sanırım,tekrar elinize sağlık
 
muhsar' Alıntı:
çok teşekkür ederim elinize sağlık,bu kodları baştaki tanımlamayı yaparak diğer çalışmalarımda da kullanabilirim sanırım,tekrar elinize sağlık
Genişletmek için tıkla ...
suskun hocam;verdiğiniz kodları başka bir makroma uyarlamaya çalıştım hatam nerde acaba rica etsem bakabilirmisiniz

ekteki kodda yıllık tsim açıp j2 hücresinden başlıyor,ben j2 yi heray makrodan değiştirmek yerine tsim sayfasında m2 ye kolon n2 ye yapıştırılacak hücreyi yani j2 yazıp aldırmak istedim fakat başaramadım tabiki

kodun yapmaya çalıştığım hali;
Kod: 
Sub yıllıktsimaktar()
'
' yıllıktsimaktar Makro
'

'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set ws = Sheets("TSİM")
kolon = ws.Range("N2").Tex
    Range("F3:F107").Select
    Selection.Copy
    Windows("yıllık tsim verileri.xlsm").Activate
    Sheets("TSİM YILLIK").Select
    ws.Range("kolon").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("TSİM.xlsm").Activate
    Sheets("tsim_ek").Select
    Range("C2:C128").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("yıllık tsim verileri.xlsm").Activate
    Sheets("TSİM EK YILLIK").Select
    ws.Range("kolon").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("TSİM.xlsm").Activate
    Sheets("TSİM").Select
    Range("M5").Select
    Set ws = Nothing

    
    Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

kod un ilk hali
Kod: 
Sub yıllıktsimaktar()
'
' yıllıktsimaktar Makro
'

'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Range("F3:F107").Select
    Selection.Copy
    Windows("yıllık tsim verileri.xlsm").Activate
    Sheets("TSİM YILLIK").Select
    Range("J3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("TSİM.xlsm").Activate
    Sheets("tsim_ek").Select
    Range("C2:C128").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("yıllık tsim verileri.xlsm").Activate
    Sheets("TSİM EK YILLIK").Select
    Range("J2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("TSİM.xlsm").Activate
    Sheets("TSİM").Select
    Range("M5").Select
    Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
hocam olayı çözdüm,çok teşekkür ederim emekleriniz için
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst