Arkadaşlar bu makroda yardımlarını beliyorum
Burada yapmak istediğim
sayfa 1 de B14:b44 arasında isimlerin karşısında bulunan d14:d44 arasında ise saatleri
Sayfa 2 deki isimlerin karşındaki kutulara değeri yazmasını istiyorum
Sorun şu Sayfa 2 deki a2:a11 asındaki kişileri yazıyor sonra siliyor.
:dua:
Sub çizelge()
Dim tarih As String
Dim isim As String
Dim son As Integer
Dim satir, sutun, i As Integer
Dim tarihalani, isimalani, tarih1, isim1 As Range
On Error Resume Next
son = Sheets("sayfa2").Range("a65536").End(xlUp).Row
Set tarihalani = Sheets("sayfa2").Range("c1:ag1")
Set isimalani = Sheets("sayfa2").Range("a3:a" & son + 15)
tarih = Sheets("sayfa1").Range("A1").Value
For i = 13 To son
isim = Sheets("sayfa1").Range("B" & i).Value
Set tarih1 = tarihalani.Find(tarih)
Set isim1 = isimalani.Find(isim)
If tarih1 Is Nothing Then
MsgBox "Aradığınız isim ve ya tarih bulunamadı.", vbCritical, "Arama Sonucu."
Exit Sub
Else:
sutun = tarih1.Column
satir = isim1.Row
Sheets("sayfa2").Cells(satir, sutun) = Sheets("sayfa1").Cells(i, 4)
End If
Next i
'Range("A1").Select
End Sub
:kafa:
Burada yapmak istediğim
sayfa 1 de B14:b44 arasında isimlerin karşısında bulunan d14:d44 arasında ise saatleri
Sayfa 2 deki isimlerin karşındaki kutulara değeri yazmasını istiyorum
Sorun şu Sayfa 2 deki a2:a11 asındaki kişileri yazıyor sonra siliyor.
:dua:
Sub çizelge()
Dim tarih As String
Dim isim As String
Dim son As Integer
Dim satir, sutun, i As Integer
Dim tarihalani, isimalani, tarih1, isim1 As Range
On Error Resume Next
son = Sheets("sayfa2").Range("a65536").End(xlUp).Row
Set tarihalani = Sheets("sayfa2").Range("c1:ag1")
Set isimalani = Sheets("sayfa2").Range("a3:a" & son + 15)
tarih = Sheets("sayfa1").Range("A1").Value
For i = 13 To son
isim = Sheets("sayfa1").Range("B" & i).Value
Set tarih1 = tarihalani.Find(tarih)
Set isim1 = isimalani.Find(isim)
If tarih1 Is Nothing Then
MsgBox "Aradığınız isim ve ya tarih bulunamadı.", vbCritical, "Arama Sonucu."
Exit Sub
Else:
sutun = tarih1.Column
satir = isim1.Row
Sheets("sayfa2").Cells(satir, sutun) = Sheets("sayfa1").Cells(i, 4)
End If
Next i
'Range("A1").Select
End Sub
:kafa: