• DİKKAT

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

Macroda belirlenen hücreyi aratmak

  • Konbuyu başlatan Konbuyu başlatan yNsr43
  • Başlangıç tarihi Başlangıç tarihi
Y

yNsr43

Katılım
24 Mart 2017
Mesajlar
148
Excel Vers. ve Dili
ofis 2013
merhaba

sayfa1 deki C14 hücresini sayfa2 de aratmak istiyorum. bi türlü beceremedim.

yardımcı olursanız sevinirim teşekkürler.
 
Merhaba örnek dosya ekleyerek paylaşım yaparsananız daha çok yardımcı olunabilir.
 
Kod: 
Sub arama()
'' fiyat

Sheets("sayfa2").Select
Range("a4:b4").Select
Selection.Copy
Sheets("sayfa1").Select
Range("a21").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
Selection.Copy
Range("a2:a9").Select
Selection.Find(What:=Range("a21").Text, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

aslında böyle birşey yaptim ama biraz dolayli yoldan oldu daha kestirme varmi acaba :)
 
Buyurun.:cool:
Kod: 
Sub arabul59()
Dim sh As Worksheet, sonsat As Long
Dim k As Range
Sheets("Sayfa2").Select
Set sh = Sheets("Sayfa1")
sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
Set k = sh.Range("A1:A" & sonsat).Find(Range("A4").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
    k.Offset(0, 1).Value = Range("B4").Value
    sh.Select
    MsgBox "Veri bulundu." & vbLf & "evrengizlen@hotmail.com"
End If
End Sub
 
eywallah hocam süper oldu, benimki pinpon topu gibi oradan oraya kopyalayıp bişeyler yapıyordu kendi çapında, bu kod yağ gibi maşallah :)

peki hocam bu kodu kapali excel dosyalarından veri almak için kullanabilirmiyiz?
deneme klasöründeki excell dosyalarının hepsine tek tek ayni bu şekilde A4 hücresine bakacak, çalışma sayfamda bulacak ve B4 hücresini sağına yapıştıracak.

teşekkürler.
 
yNsr43' Alıntı:
eywallah hocam süper oldu, benimki pinpon topu gibi oradan oraya kopyalayıp bişeyler yapıyordu kendi çapında, bu kod yağ gibi maşallah :)

peki hocam bu kodu kapali excel dosyalarından veri almak için kullanabilirmiyiz?
deneme klasöründeki excell dosyalarının hepsine tek tek ayni bu şekilde A4 hücresine bakacak, çalışma sayfamda bulacak ve B4 hücresini sağına yapıştıracak.

teşekkürler.
Genişletmek için tıkla ...

Kapalı dosyalardan veri alınabilir.
Bu iş için ado yada executeexcel4 makrosu ile yada dosyayı makro ile açıp kapayıp veri alınabilir.Hangisi uygunsa o yöntem uygulanabilir.:cool:
 
Kod: 
Sub BilgiAl()
Dim i As Long
Dim Yol As String, Adres As String
Dim Nesne, Klasor, Dosya

Yol = "C:\Users\"

Set Nesne = CreateObject("Scripting.FileSystemObject")
Set Klasor = Nesne.getfolder(Yol)

i = 1

For Each Dosya In Klasor.Files
Adres = "'" & Yol & "\[" & Dosya.Name & "]Sayfa1'!"
Cells(i, 1) = ExecuteExcel4Macro(Adres & Range("a4").Address(True, True, xlR1C1))
Cells(i, 2) = ExecuteExcel4Macro(Adres & Range("b4").Address(True, True, xlR1C1))
Cells(i, 3) = ExecuteExcel4Macro(Adres & Range("d4").Address(True, True, xlR1C1))
i = i + 1
Next Dosya
End Sub

hocam böyle bişey buldum ama

#BAŞV! #BAŞV! #BAŞV!
#BAŞV! #BAŞV! #BAŞV!
#BAŞV! #BAŞV! #BAŞV!

çıkıyor neden kaynaklaniyor olabilir
 
Örnek dosyalarınızı ekleyiniz.:cool:
 
Verileri alınacak dosyalar(Kaynak dosyalar)
Ve ana dosya(Hedef dosya) yı eklemenizi istemiştim.
Ona göre kod yazacam.denemem lazım kodları.Kafadan afaki yazamam.
 
kaynak dosyalarda verilerin olduğu sayfaların adlarının hepsi ayni olmalı.
Ben hepsinin adını Sayfa1 yaptım.kaynak Excel dosya uzantıları xlsx olmalı.
dosya linktedir.:cool:

DOSYAYI İNDİR

Kod: 
Sub BilgiAl()
Dim i As Long, k As Range, deg  As String, deg2 As Variant
Dim Yol As String, dosya As String
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
Yol = ThisWorkbook.Path & "\kaynak\"
dosya = Dir(Yol & "*.xlsx")
Do While dosya <> ""
    deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & _
            "\kaynak\[" & dosya & "]Sayfa1'!R4C1")
    deg2 = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & _
            "\kaynak\[" & dosya & "]Sayfa1'!R4C2")
    Set k = Range("A1:A" & sonsat).Find(deg, , xlValues, xlWhole)
    If Not k Is Nothing Then k.Offset(0, 1).Value = deg2
    dosya = Dir
Loop
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"

End Sub
 
teşekkürler hocam eline sağlık.
bunu dosya içindeki sayfa isimlerini Sheets(1) yani isimi ne olursa olsun ilk sayfada işlem yapsa olmaz mi
 
o zaman kaynak klasöründeki excellerin sayfa isimlerini değiştirmenin bir yolunu bulacam :)
tekrar teşekkürler .
 
yNsr43' Alıntı:
o zaman kaynak klasöründeki excellerin sayfa isimlerini değiştirmenin bir yolunu bulacam :)
tekrar teşekkürler .
Genişletmek için tıkla ...

Dosya aç kapa yöntemi ile sayfa adları ne olursa olsun,işlem yapılabilir .İsterseniz öyle yapayım.Bu gün geç oldu.Yarın bakarım.:cool:
 
yNsr43' Alıntı:
o zaman kaynak klasöründeki excellerin sayfa isimlerini değiştirmenin bir yolunu bulacam :)
tekrar teşekkürler .
Genişletmek için tıkla ...
Dosya linktedir.:cool:

DOSYAYI İNDİR

Kod: 
Sub BilgiAl59()
Dim i As Long, k As Range, deg  As String, deg2 As Variant
Dim Yol As String, dosya As String
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
Yol = ThisWorkbook.Path & "\kaynak\"
dosya = Dir(Yol & "*.xlsx")
Do While dosya <> ""
    Application.DisplayAlerts = False
    If Workbooks.Open(Yol & dosya).ReadOnly = True Then Workbooks(dosya).Close True
    Application.DisplayAlerts = True
    deg = ActiveWorkbook.Sheets(1).Range("A4").Value
    deg2 = ActiveWorkbook.Sheets(1).Range("B4").Value
    ActiveWorkbook.Close False
    Set k = Range("A1:A" & sonsat).Find(deg, , xlValues, xlWhole)
    If Not k Is Nothing Then k.Offset(0, 1).Value = deg2
    dosya = Dir
Loop
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"

End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst