• DİKKAT

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

Veri Aktarımı

  • Konbuyu başlatan Konbuyu başlatan domino
  • Başlangıç tarihi Başlangıç tarihi
Katılım
4 Kasım 2005
Mesajlar
66
Ekte gönderdiğim dosyada iki adet ecxel dosyası bulunmaktadır. Birincisi internete yüklediğim veriler dosyası ikincisi bilgisayarımda bulunan ana dosya
Ana dosyada adı soyadı kısmına yazmış olduğum isime göre veriler dosyasındaki o isme karşılık gelen bilgilerin aşağıda yer almasını istiyorum. Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.
 

Ekli dosyalar

Ekte gönderdiğim dosyada iki adet ecxel dosyası bulunmaktadır. Birincisi internete yüklediğim veriler dosyası ikincisi bilgisayarımda bulunan ana dosya
Ana dosyada adı soyadı kısmına yazmış olduğum isime göre veriler dosyasındaki o isme karşılık gelen bilgilerin aşağıda yer almasını istiyorum. Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

Merhaba
Boş bir module Kopyalayın ve deneyin.
Kod:
Option Explicit
Sub karşılık_bul_1967()
'Konu       :   Karşılık Bulma
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim s1 As Worksheet, s2 As Worksheet
Dim a As Long, yol As String, kapalı As String
Application.ScreenUpdating = False
Set s1 = Workbooks(ActiveWorkbook.Name).Sheets("Ana")
yol = ThisWorkbook.Path & "\"
kapalı = "Veriler.xlsx"
Workbooks.Open (yol & kapalı)
Set s2 = Workbooks(kapalı).Sheets("VERİLER")
s1.Range("C4:C11").ClearContents
If s1.Range("C3") <> Empty Then
If WorksheetFunction.CountIf(s2.Range("A:A"), s1.Range("C3")) > 0 Then
a = WorksheetFunction.Match(s1.Range("C3"), s2.Range("A:A"), 0)
s1.Range("C4") = s2.Cells(a, "B")
s1.Range("C5") = s2.Cells(a, "C")
s1.Range("C6") = s2.Cells(a, "D")
s1.Range("C7") = s2.Cells(a, "E")
s1.Range("C8") = s2.Cells(a, "F")
s1.Range("C9") = s2.Cells(a, "G")
s1.Range("C10") = s2.Cells(a, "H").Value
s1.Range("C11") = s2.Cells(a, "I").Value
End If: End If
Workbooks(kapalı).Close
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub
Dosyanız Ekte
 

Ekli dosyalar

Geri
Üst