Şarta Göre Kapalı Dosyaya Select Case ile Veri Yazma

[ahmed_ummu]

Merhaba arkadaşlar

Bi konuda yardım rica edeceğim.

Örnek dosyamda userform1 açıldığında, veri sayfasını b sütununu son satıra kadar kontrol edecek. H sütunundaki veri "İŞ-KUR (TYP) TEMİZLİK" ise kapalı olan "typ_işkur_çizelge" kitabını açıp, "TYPİ1" sayfasına veri sayfasındaki şarta (F sütunundaki rakam sırasına göre) uyan kişinin adını ve t.c. numarasını belirtilen hücrelere yazacak.

Form açılınca hiçbir hata vermiyor ama işlevini yapmıyor.

Yardımcı olursanız sevinirim.

 

[ahmed_ummu]

Kodları aşağıdaki gibi değiştirdim ama yine bir hata vermiyor ama yapmak istediğim işlemi de yapmıyor.

Private Sub UserForm_Initialize()
Set v = Sheets("veri")
For i = 2 To v.Cells(Rows.Count, "b").End(3).Row
If v.Cells(i, "ı").Value = "İŞ-KUR (TYP) TEMİZLİK" Then
adi = v.Cells(Rows.Count, "b").Value
tc = v.Cells(Rows.Count, "c").Value
sira = v.Cells(i, "g").Value

Application.Workbooks.Open ThisWorkbook.Path & "\" & "typ_işkur_çizelge.xlsx"
Select Case sira
Case Is = 1
Sheets("TYPİ1").Range("c12").Value = adi
Sheets("TYPİ1").Range("c12").Value = tc

Case Is = 2
Sheets("TYPİ1").Range("g12").Value = adi
Sheets("TYPİ1").Range("g12").Value = tc

Case Is = 3
Sheets("TYPİ1").Range("k12").Value = adi
Sheets("TYPİ1").Range("k12").Value = tc

Case Is = 4
Sheets("TYPİ1").Range("o12").Value = adi
Sheets("TYPİ1").Range("o12").Value = tc
End Select
End If
Next i
'Application.Workbooks("typ_işkur_çizelge").Close SaveChanges:=True
End Sub

 

[halit3]

bu kodu bir dene

Sub Makro1()

Set v = Workbooks(ThisWorkbook.Name).Sheets("veri")

Application.Workbooks.Open ThisWorkbook.Path & "\" & "typ_işkur_çizelge.xlsx"
Set r = Workbooks(ActiveWorkbook.Name).Sheets("TYPİ1")

For i = 2 To v.Cells(Rows.Count, "b").End(3).Row
If v.Cells(i, "ı").Value = "İŞ-KUR (TYP) TEMİZLİK" Then
adi = v.Cells(i, "b").Value
tc = v.Cells(i, "c").Value
sira = v.Cells(i, "g").Value
Select Case sira

Case Is = 1
r.Range("c12").Value = adi
r.Range("c13").Value = tc

Case Is = 2
r.Range("g12").Value = adi
r.Range("g13").Value = tc

Case Is = 3
r.Range("k12").Value = adi
r.Range("k13").Value = tc

Case Is = 4
r.Range("o12").Value = adi
r.Range("o13").Value = tc
End Select
End If
Next i
ActiveWorkbook.Close SaveChanges:=True


End Sub

 

[ahmed_ummu]

bu kodu bir dene

Sub Makro1()

Set v = Workbooks(ThisWorkbook.Name).Sheets("veri")

Application.Workbooks.Open ThisWorkbook.Path & "\" & "typ_işkur_çizelge.xlsx"
Set r = Workbooks(ActiveWorkbook.Name).Sheets("TYPİ1")

For i = 2 To v.Cells(Rows.Count, "b").End(3).Row
If v.Cells(i, "ı").Value = "İŞ-KUR (TYP) TEMİZLİK" Then
adi = v.Cells(i, "b").Value
tc = v.Cells(i, "c").Value
sira = v.Cells(i, "g").Value
Select Case sira

Case Is = 1
r.Range("c12").Value = adi
r.Range("c13").Value = tc

Case Is = 2
r.Range("g12").Value = adi
r.Range("g13").Value = tc

Case Is = 3
r.Range("k12").Value = adi
r.Range("k13").Value = tc

Case Is = 4
r.Range("o12").Value = adi
r.Range("o13").Value = tc
End Select
End If
Next i
ActiveWorkbook.Close SaveChanges:=True


End Sub

Halit bey bir hata vermedi ama işlevi yapmadı.

 

[ahmed_ummu]

Kodları aşağıdaki gibi değiştirdim ama yine bir hata vermiyor ama yapmak istediğim işlemi de yapmıyor.

Private Sub UserForm_Initialize()
Set v = Sheets("veri")
For i = 2 To v.Cells(Rows.Count, "b").End(3).Row
If v.Cells(i, "ı").Value = "İŞ-KUR (TYP) TEMİZLİK" Then
adi = v.Cells(Rows.Count, "b").Value
tc = v.Cells(Rows.Count, "c").Value
sira = v.Cells(i, "g").Value

Application.Workbooks.Open ThisWorkbook.Path & "\" & "typ_işkur_çizelge.xlsx"
Select Case sira
Case Is = 1
Sheets("TYPİ1").Range("c12").Value = adi
Sheets("TYPİ1").Range("c12").Value = tc

Case Is = 2
Sheets("TYPİ1").Range("g12").Value = adi
Sheets("TYPİ1").Range("g12").Value = tc

Case Is = 3
Sheets("TYPİ1").Range("k12").Value = adi
Sheets("TYPİ1").Range("k12").Value = tc

Case Is = 4
Sheets("TYPİ1").Range("o12").Value = adi
Sheets("TYPİ1").Range("o12").Value = tc
End Select
End If
Next i
'Application.Workbooks("typ_işkur_çizelge").Close SaveChanges:=True
End Sub

Çok teşekkürler Halit bey çalıştı. İşlemi yapıyor.