• DİKKAT

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

Farklı Dosyadaki Verilerle Tablo Oluşturmak

Katılım
6 Haziran 2013
Mesajlar
4
Excel Vers. ve Dili
EXCEL 2007
Türkçe
Merhabalar herkese
Öncelikle EXCEL VB programlamaya yeni başladım.Bu da ilk sorum olacak
Şöyle ki:

Ekteki "LİSTE" isimli dosyada C sütunundaki ve "TABLO" isimli dosyada B sütunundaki herhangi iki hücrenin eşleşmesi durumunda eşleşen hücrenin B sütunundaki isim 1 nolu sayfa 1 nolu sütuna 2 nolu sayfa 2 nolu sütuna yazılacak bu şekilde tablo oluşturulacak

Liste daha uzuyor ama ben emsal olması açısından ilk 5 satırını aldım

Teşekkürler..
 

Ekli dosyalar

sn exsell
Aşağıdaki kodları LİSTE.xlsm dosyasında bir modül sayfasına yapıştırın bu iki dosyada aynı klasörde bulunsunlar
Kod:
Sub Aktar()
Dim XCL As Application, KTP As Workbook
Dim S1 As Worksheet
Set XCL = CreateObject("Excel.Application")
Set KTP = XCL.Workbooks.Open(ThisWorkbook.Path & "/TABLO.xlsx")
Set S1 = KTP.Sheets("Sayfa1")
say = S1.Range("a65536").End(3).Row
For i = 2 To say
If Application.CountIf(Sheets("1").Columns(3), S1.Range("b" & i)) = 1 Then
sayfa = 1
hücre = "C"
ElseIf Application.CountIf(Sheets("2").Columns(3), S1.Range("b" & i)) = 1 Then
sayfa = 2
hücre = "D"
Else
sayfa = 0
End If
If sayfa <> 0 Then
S1.Range(hücre & i).Value = Sheets(sayfa).Cells.Find(What:=S1.Range("b" & i), After:=Sheets(sayfa).Range("A1"), LookAt:=xlWhole, LookIn:=xlFormulas).Offset(0, -1)
  End If
        Next
        Set S1 = Nothing
        KTP.Save
        KTP.Close
        Set KTP = Nothing
        Set XCL = Nothing
End Sub
 
Son düzenleme:
Çok teşekkürler Ömer bey problem çözülmekle kalmadı aynı zamanda yeni komutlar öğrenmiş oldum.
 
Geri
Üst