Activecell.offset İle Yazdırma Sorunu

ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Merhaba arkadaşlar.

Aktif sayfadaki r21, s21, t21, u21, v21 hücrelerindeki verileri Sayfa1 sayfasındaki seçili hücrenin 54... sağına yazmak istiyorum. Aşağıdaki kod ile sayfa1 sayfasındaki p12 hücresindeki ismi seçiyo ama seçşli hücrenin 54 sağına yazmıyor. Bir sorun görünmüyo ama yazmıyor. Hata da vermiyor

Private Sub CommandButton2_Click()

gunduz1 = Range("r21").Value
gunduz2 = Range("s21").Value
gunduz3 = Range("t21").Value
gunduz4 = Range("u21").Value
gunduz5 = Range("v21").Value
suz = Range("p12").Value

On Error Resume Next

Sheets("sayfa1").Select
For sut = 45 To [b65000].End(xlUp).Row
If Range("b" & sut) Like suz Then
Range("b" & sut).Select 'Buraya kadar çalışıyor. Alttaki kodların işlevini yapmıyor.

ActiveCell.Offset(0, 54).Value = gunduz1
ActiveCell.Offset(0, 55).Value = gunduz2
ActiveCell.Offset(0, 56).Value = gunduz3
ActiveCell.Offset(0, 57).Value = gunduz4
ActiveCell.Offset(0, 58).Value = gunduz5
End If
Next sut
End Sub
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
On Error Resume Next satırını silin, hangi satırda hata verdiğini ve hata mesajını söyleyin.
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Hata varsa ve gördükten sonra kodlarınızı SELECT kullanamdan aşağıdkai gibi yazabilirsiniz.
C++: 
If Range("b" & sut) Like suz Then
    For x=54 to 58
        Range("b" & sut).Offset(0, x).Value = gunduz1
    Next x
End if
 
ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
ÖmerFaruk' Alıntı:
Hata varsa ve gördükten sonra kodlarınızı SELECT kullanamdan aşağıdkai gibi yazabilirsiniz.
C++: 
If Range("b" & sut) Like suz Then
    For x=54 to 58
        Range("b" & sut).Offset(0, x).Value = gunduz1
    Next x
End if
Genişletmek için tıkla ...
Teşekkürler Ömer Faruk bey.
Aşağıdaki gibi yaptım gönderdiğiniz kodları ama yine yazmadı.

Private Sub CommandButton2_Click()

gunduz1 = Range("r21").Value
gunduz2 = Range("s21").Value
gunduz3 = Range("t21").Value
gunduz4 = Range("u21").Value
gunduz5 = Range("v21").Value
suz = Range("p12").Value

On Error Resume Next

Sheets("sayfa1").Select
For sut = 45 To [b65000].End(xlUp).Row
If Range("b" & sut) Like suz Then
Range("b" & sut).Select

If Range("b" & sut) Like suz Then
For x = 54 To 58
Range("b" & sut).Offset(0, x).Value = gunduz1
Next x
End If

End If
Next sut
'Sheets ("ücret giriş")
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
@Muzaffer Ali beyin dediğini yaptınız mı?
Eğer yapamıyor ya da bulamıyorsanız dosyanızı biizmle paylaşabilirsiniz.
 
ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Ali beyin dediği gibi yaptım ama hata vermiyor. Dosyayı linkini verdim.
EKDERS GİRİŞ sayfasında yapılacak işlemler

İndir VERİ TABANI

Dosyayı indir VERİ TABANI
dosya.co
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Farklı bir sayfaya aktarmak istediğinizden olmuyor.
Kodları revize ettim deneyiniz.

Kod: 
Private Sub CommandButton2_Click()
    Dim Suz As Variant
    Dim Sut As Integer
    Suz = Range("p12").Value
    With Sheets("sayfa1")
        For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
            If .Range("b" & sut) Like Suz Then
                .Cells(sut, 56) = Range("r21").Value
                .Cells(sut, 57) = Range("s21").Value
                .Cells(sut, 58) = Range("t21").Value
                .Cells(sut, 59) = Range("r21").Value
                .Cells(sut, 60) = Range("v21").Value
            End If
        Next sut
    End With
End Sub
 
ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Muzaffer Ali' Alıntı:
Farklı bir sayfaya aktarmak istediğinizden olmuyor.
Kodları revize ettim deneyiniz.

Kod: 
Private Sub CommandButton2_Click()
    Dim Suz As Variant
    Dim Sut As Integer
    Suz = Range("p12").Value
    With Sheets("sayfa1")
        For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
            If .Range("b" & sut) Like Suz Then
                .Cells(sut, 56) = Range("r21").Value
                .Cells(sut, 57) = Range("s21").Value
                .Cells(sut, 58) = Range("t21").Value
                .Cells(sut, 59) = Range("r21").Value
                .Cells(sut, 60) = Range("v21").Value
            End If
        Next sut
    End With
End Sub
Genişletmek için tıkla ...
Çok teşekkürler sorunsuz çalışıyor.
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Yazmışken alternatif olsun.
C++: 
Private Sub CommandButton2_Click()
Dim Alan As Range, Bul As Range, x As Integer
With Sheets("Sayfa1")
    Set Alan = .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row)
    Set Bul = Alan.Find(Range("p12").Value, , xlValues, xlWhole)
    If Bul Is Nothing Then MsgBox "Öğretmen bulunamadı": Exit Sub
    For x = 54 To 58
        Bul.Offset(0, x) = Cells(21, 18 + x - 54)
    Next x
    MsgBox "İşlem tamamlandı."
End With
End Sub
 
ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Merhaba arkadaşlar.

Muzaffer Ali beyin gönderdiği Aşağıdaki kod ile "Ekders Giriş" sayfasındaki kodlarda görülen hücre değerlerini "Sayfa1" sayfasındaki hücrelere yazdırdım. Şimdi ise tam tersini yapmak istiyorum. Kırmızı kod bloğunun tam tersini yapmak istiyorum. "Sayfa1" sayfasındaki verileri "Ekders Giriş" sayfasına aldırmak istiyorum. Birkaç deneme yaptım ama olmadı. Yardımcı olursanız sevinirim.

Dim Suz As Variant
Dim Sut As Integer
Suz = Range("p12").Value
With Sheets("sayfa1")
For Sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
If .Range("b" & Sut) Like Suz Then
.Cells(Sut, 56) = Range("P21").Value
.Cells(Sut, 57) = Range("Q21").Value
.Cells(Sut, 58) = Range("R21").Value
.Cells(Sut, 59) = Range("S21").Value
.Cells(Sut, 60) = Range("T21").Value
.Cells(Sut, 61) = Range("W21").Value
.Cells(Sut, 62) = Range("AG21").Value
End If
Next Sut
End With
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
= işaretinin sağındakini sola soldakini sağa alın.
Kod: 
.Cells(Sut, 56) = Range("P21").Value
Aşağıdaki gibi olacak.
Kod: 
Range("P21").Value = .Cells(Sut, 56)
diğer satırları da siz yaparsınız.
 
ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Muzaffer Ali' Alıntı:
= işaretinin sağındakini sola soldakini sağa alın.
Kod: 
.Cells(Sut, 56) = Range("P21").Value
Aşağıdaki gibi olacak.
Kod: 
Range("P21").Value = .Cells(Sut, 56)
diğer satırları da siz yaparsınız.
Genişletmek için tıkla ...
Teşekkürler Muzaffer Ali bey. Aynısını yaptım ama olmadı hiç birşey yazmadı.

Aşağıdaki gibi yaptım ama böyle uzun kod yazmak gerekecek.

Sheets("sayfa1").Select
On Error Resume Next
For Sut = 45 To [b65000].End(xlUp).Row
If Range("b" & Sut) Like ListBox1.Text Then
Range("b" & Sut).Select
adi = ActiveCell.Offset(0, 0)
bransi = ActiveCell.Offset(0, 9)

gunduz1 = ActiveCell.Offset(0, 54).Value
gunduz2 = ActiveCell.Offset(0, 55).Value
gunduz3 = ActiveCell.Offset(0, 56).Value
gunduz4 = ActiveCell.Offset(0, 57).Value
gunduz5 = ActiveCell.Offset(0, 58).Value
gunduz6 = ActiveCell.Offset(0, 59).Value
gunduz7 = ActiveCell.Offset(0, 60).Value

Sheets("ekders giriş").Select
Sheets("ekders giriş").Range("p12").Value = adi
Sheets("ekders giriş").Range("p13").Value = bransi

Sheets("ekders giriş").Range("p21").Value = gunduz1
Sheets("ekders giriş").Range("q21").Value = gunduz2
Sheets("ekders giriş").Range("r21").Value = gunduz3
Sheets("ekders giriş").Range("s21").Value = gunduz4
Sheets("ekders giriş").Range("t21").Value = gunduz5
Sheets("ekders giriş").Range("w21").Value = gunduz6
Sheets("ekders giriş").Range("ag21").Value = gunduz7


End If
Next Sut

Daha kısa olması için yardımcı olursanız sevinirim.
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Kod: 
gunduz1 = ActiveCell.Offset(0, 54).Value
Gibi olan satırlara gerek yok.

Kod: 
Sheets("ekders giriş").Range("p21").Value = ActiveCell.Offset(0, 54).Value
şeklinde yapın.
Yani "gunduz", "adi" ve "bransi" değişkenlerini kullanmadan direk yazın.


Sheets("ekders giriş").Select satırını silin.
 
ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Muzaffer Ali' Alıntı:
Kod: 
gunduz1 = ActiveCell.Offset(0, 54).Value
Gibi olan satırlara gerek yok.

Kod: 
Sheets("ekders giriş").Range("p21").Value = ActiveCell.Offset(0, 54).Value
şeklinde yapın.
Yani "gunduz", "adi" ve "bransi" değişkenlerini kullanmadan direk yazın.


Sheets("ekders giriş").Select satırını silin.
Genişletmek için tıkla ...
Aşağıdaki gibi yaptım ama yine olmadı. Sayfa1 sayfasına gelip adı seçili olan kişinin ismine konumlanıyo imleç

Sheets("sayfa1").Select
On Error Resume Next
For Sut = 45 To [b65000].End(xlUp).Row
If Range("b" & Sut) Like ListBox1.Text Then
Range("b" & Sut).Select

Sheets("ekders giriş").Range("p12").Value = ActiveCell.Offset(0, 0).Value
Sheets("ekders giriş").Range("p13").Value = ActiveCell.Offset(0, 9).Value
Sheets("ekders giriş").Range("p21").Value = ActiveCell.Offset(0, 54).Value
Sheets("ekders giriş").Range("q21").Value = ActiveCell.Offset(0, 54).Value
Sheets("ekders giriş").Range("r21").Value = ActiveCell.Offset(0, 54).Value
Sheets("ekders giriş").Range("s21").Value = ActiveCell.Offset(0, 54).Value
Sheets("ekders giriş").Range("t21").Value = ActiveCell.Offset(0, 54).Value
Sheets("ekders giriş").Range("w21").Value = ActiveCell.Offset(0, 54).Value
Sheets("ekders giriş").Range("ag21").Value = ActiveCell.Offset(0, 54).Value

End If
Next Sut
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
İlk verdiğim kod.

Kod: 
Private Sub CommandButton2_Click()
    Dim Suz As Variant
    Dim Sut As Integer
    Suz = Range("p12").Value
    With Sheets("sayfa1")
        For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
            If .Range("b" & sut) Like Suz Then
                .Cells(sut, 56) = Range("r21").Value
                .Cells(sut, 57) = Range("s21").Value
                .Cells(sut, 58) = Range("t21").Value
                .Cells(sut, 59) = Range("r21").Value
                .Cells(sut, 60) = Range("v21").Value
            End If
        Next sut
    End With
End Sub
Verilerin terse gelmesini istiyorsanız hücre adreslerinin yerini değiştirin.
Örnek.
Kod: 
 .Cells(sut, 56) = Range("r21").Value
Satırını aşağıdaki gibi = işaretinin sağındakini sola soldakini sağa yazın.
Kod: 
 Range("r21").Value = .Cells(sut, 56)
 
ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Muzaffer Ali' Alıntı:
İlk verdiğim kod.

Kod: 
Private Sub CommandButton2_Click()
    Dim Suz As Variant
    Dim Sut As Integer
    Suz = Range("p12").Value
    With Sheets("sayfa1")
        For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
            If .Range("b" & sut) Like Suz Then
                .Cells(sut, 56) = Range("r21").Value
                .Cells(sut, 57) = Range("s21").Value
                .Cells(sut, 58) = Range("t21").Value
                .Cells(sut, 59) = Range("r21").Value
                .Cells(sut, 60) = Range("v21").Value
            End If
        Next sut
    End With
End Sub
Verilerin terse gelmesini istiyorsanız hücre adreslerinin yerini değiştirin.
Örnek.
Kod: 
 .Cells(sut, 56) = Range("r21").Value
Satırını aşağıdaki gibi = işaretinin sağındakini sola soldakini sağa yazın.
Kod: 
 Range("r21").Value = .Cells(sut, 56)
Genişletmek için tıkla ...
Dim Suz As Variant
Dim Sut As Integer
Suz = Range("p12").Value
With Sheets("sayfa1") Bu satırda değişiklik olacak mı. İlk verdiğiniz kod da Ekders giriş sayfasından SAyfa1 sayfasına yazdırmıştık. Şimdi ise Sayfa1
sayfasından, Ekders giriş sayfasına yazdıracağız.
For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
If .Range("b" & sut) Like Suz Then
.Cells(sut, 56) = Range("r21").Value
.Cells(sut, 57) = Range("s21").Value
.Cells(sut, 58) = Range("t21").Value
.Cells(sut, 59) = Range("r21").Value
.Cells(sut, 60) = Range("v21").Value
End If
Next sut
End With
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Kodlar eğer Sayfa1'in kod kısmında olacaksa aşağıdaki kodları kullanın.
Kod: 
Private Sub CommandButton2_Click()
    Dim Suz As Variant
    Dim Sut As Integer
    Suz = Range("p12").Value
    With Sheets("sayfa1")
        For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
            If .Range("b" & sut) Like Suz Then
                Range("r21").Value = .Cells(sut, 56)
                Range("s21").Value = .Cells(sut, 57)
                Range("t21").Value = .Cells(sut, 58)
                Range("r21").Value = .Cells(sut, 59)
                Range("v21").Value = .Cells(sut, 60)
            End If
        Next sut
    End With
End Sub
Eğer kodlar Ekders sayfasında olacaksa aşağıdaki kodları kullanın.
Kod: 
Private Sub CommandButton2_Click()
    Dim Suz As Variant
    Dim Sut As Integer
    Suz = Range("p12").Value
    With Sheets("Ekders")
        For sut = 45 To .Cells(Rows.Count, "B").End(xlUp).Row
            If .Range("b" & sut) Like Suz Then
                .Cells(sut, 56) = Range("r21").Value
                .Cells(sut, 57) = Range("s21").Value
                .Cells(sut, 58) = Range("t21").Value
                .Cells(sut, 59) = Range("r21").Value
                .Cells(sut, 60) = Range("v21").Value
            End If
        Next sut
    End With
End Sub
 
Son düzenleme:
ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Muzaffer Ali' Alıntı:
Kodlar eğer Sayfa1'in kod kısmında olacaksa son verdiğim kod olacak
Eğer kodlar Ekders sayfasında olacaksa kodlarda bulunan With Sheets("sayfa1") satırını With Sheets("Ekders") yapın
Genişletmek için tıkla ...
Çok teşekkürler. İşyerinin bilgisayarında çalışıyorum. Okul kapanıyo şu an yarın denerim. İyi akşamlar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst