• DİKKAT

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

Soru alanları otomatik kopyalama

Dosyanızda birleştirilmiş hücreler ve hatalı hücreler var. Ben örnek olması açısından 72. satıra kadar çalışan bir makro yazdım. Kontrol edip kendi dosyanıza göre uyarlarsınız.

Kod: 
Sub aktar()

Application.ScreenUpdating = False

For t = 3 To 72

    If Cells(t, "B") = "" And Cells(t, "C") <> "" Then Cells(t, "E") = Cells(t, "C")
    If Cells(t, "B") <> "" And Cells(t, "C") Then Cells(t, "E") = Cells(t, "B")
Next

Range("B3:C72").Select
Selection.ClearContents
Range("A1").Select
Application.ScreenUpdating = True

End Sub
 
Sub aktar()

Application.ScreenUpdating = False

For t = 3 To 135

If Cells(t, "G") = "" And Cells(t, "H") <> "" Then Cells(t, "J") = Cells(t, "H")
If Cells(t, "G") <> "" And Cells(t, "H") Then Cells(t, "J") = Cells(t, "G")
Next

Range("G3:I11;G13:I40;G42:I72;G80:I135").Select
Selection.ClearContents
Range("R1").Select
Application.ScreenUpdating = True

End Sub



bu kodla revize ettim olmadı hocam
 

Ekli dosyalar

Tablonuza göre güncelledim. Aşağıdaki şekilde deneyiniz.


Kod: 
Sub aktar()

Application.ScreenUpdating = False

For t = 3 To 72
If Cells(t, "G") = "" And Cells(t, "H") <> "" Then Cells(t, "J") = Cells(t, "H")
If Cells(t, "G") <> "" And Cells(t, "H") Then Cells(t, "J") = Cells(t, "G")
Next

For t = 80 To 135
If Cells(t, "G") = "" And Cells(t, "H") <> "" Then Cells(t, "J") = Cells(t, "H")
If Cells(t, "G") <> "" And Cells(t, "H") Then Cells(t, "J") = Cells(t, "G")
Next

Range("G3:I11").Select
Selection.ClearContents
Range("G13:I40").Select
Selection.ClearContents
Range("G42:I72").Select
Selection.ClearContents
Range("G80:I135").Select
Selection.ClearContents
Range("R1").Select
Application.ScreenUpdating = True

End Sub
 
Öncelikle desteklerinizden dolayı teşekkürler hocam ancak kend orjinal dosyama adapte edince aşağıdaki şekilde hata veriyor nedendir acaba anlamadım.


225159
225160
 
bmutlu966' Alıntı:
Tablonuza göre güncelledim. Aşağıdaki şekilde deneyiniz.


Kod: 
Sub aktar()

Application.ScreenUpdating = False

For t = 3 To 72
If Cells(t, "G") = "" And Cells(t, "H") <> "" Then Cells(t, "J") = Cells(t, "H")
If Cells(t, "G") <> "" And Cells(t, "H") Then Cells(t, "J") = Cells(t, "G")
Next

For t = 80 To 135
If Cells(t, "G") = "" And Cells(t, "H") <> "" Then Cells(t, "J") = Cells(t, "H")
If Cells(t, "G") <> "" And Cells(t, "H") Then Cells(t, "J") = Cells(t, "G")
Next

Range("G3:I11").Select
Selection.ClearContents
Range("G13:I40").Select
Selection.ClearContents
Range("G42:I72").Select
Selection.ClearContents
Range("G80:I135").Select
Selection.ClearContents
Range("R1").Select
Application.ScreenUpdating = True

End Sub
Genişletmek için tıkla ...



hocam yeni hata nedendir acaba?
 
bmutlu966' Alıntı:
Orijinal dosyanız buysa problemsiz çalışıyor.
Genişletmek için tıkla ...

Orjinal dosya bu değil hocam sağda ve aşağıda bazı hücreler var ancak alanlar birebir aynı. Bu dosyada çalışıp birebir aynı olan dosyaya adapte edince neden olmuyor çözemedim hocam.
 
bmutlu966' Alıntı:
Orijinal dosyanız buysa problemsiz çalışıyor.
Genişletmek için tıkla ...

Sanırım sorunu buldum hocam ama çözüm bulamadım.

1.AYAR ve 2.AYAR kısımlarına sayı girilirse sorun yok ancak mesela Tip kısmında sayı var 1.AYAR kısmın A 125 yazıyor o zaman aktarmıyor.
 
Kodda hata yapmışız. Sanırım şimdi probleminiz çözülecek.

Kod: 
Sub aktar()

Application.ScreenUpdating = False

For t = 3 To 72
If Cells(t, "G") = "" And Cells(t, "H") <> "" Then Cells(t, "J") = Cells(t, "H")
If Cells(t, "G") <> "" And Cells(t, "H") <> "" Then Cells(t, "J") = Cells(t, "G")
Next

For t = 80 To 135
If Cells(t, "G") = "" And Cells(t, "H") <> "" Then Cells(t, "J") = Cells(t, "H")
If Cells(t, "G") <> "" And Cells(t, "H") Then Cells(t, "J") = Cells(t, "G")
Next

Range("G3:I11").Select
Selection.ClearContents
Range("G13:I40").Select
Selection.ClearContents
Range("G42:I72").Select
Selection.ClearContents
Range("G80:I135").Select
Selection.ClearContents
Range("R1").Select
Application.ScreenUpdating = True

End Sub
 
bmutlu966' Alıntı:
Kodda hata yapmışız. Sanırım şimdi probleminiz çözülecek.

Kod: 
Sub aktar()

Application.ScreenUpdating = False

For t = 3 To 72
If Cells(t, "G") = "" And Cells(t, "H") <> "" Then Cells(t, "J") = Cells(t, "H")
If Cells(t, "G") <> "" And Cells(t, "H") <> "" Then Cells(t, "J") = Cells(t, "G")
Next

For t = 80 To 135
If Cells(t, "G") = "" And Cells(t, "H") <> "" Then Cells(t, "J") = Cells(t, "H")
If Cells(t, "G") <> "" And Cells(t, "H") Then Cells(t, "J") = Cells(t, "G")
Next

Range("G3:I11").Select
Selection.ClearContents
Range("G13:I40").Select
Selection.ClearContents
Range("G42:I72").Select
Selection.ClearContents
Range("G80:I135").Select
Selection.ClearContents
Range("R1").Select
Application.ScreenUpdating = True

End Sub
Genişletmek için tıkla ...


Burda ne gibi bir değişiklik yaptınız hocam? Kodu incelediğimde sanki bir değişiklik yok gibi gördüm. Orjinal dosyam işyerimde olduğundan dolayı dolayı deneyemedim yarın deneyeceğim sadece kodları bire bir kıyaslama yaptım ancak bir değişiklik göremeyince merak ettim sadece
 
Kod: 
If Cells(t, "G") <> "" And Cells(t, "H") Then Cells(t, "J") = Cells(t, "G")
And ten sonra gelen koşula bir koşul eklememişsiniz.
Benim gördüğüm budur.
 
Orion1' Alıntı:
Kod: 
If Cells(t, "G") <> "" And Cells(t, "H") Then Cells(t, "J") = Cells(t, "G")
And ten sonra gelen koşula bir koşul eklememişsiniz.
Benim gördüğüm budur.
Genişletmek için tıkla ...

mesela ne gibi hocam? Bu komutla rakamlarla gayet güzel aktarıyor ancak harfli olanlarda hata veriyor.
 
Orion1' Alıntı:
Kod: 
If Cells(t, "G") <> "" And Cells(t, "H") Then Cells(t, "J") = Cells(t, "G")
And ten sonra gelen koşula bir koşul eklememişsiniz.
Benim gördüğüm budur.
Genişletmek için tıkla ...

keşke sizler gibi uzman olabilsem hocam hemen yapacağım ama yapamıyorum
 
İlk şartta <> "" kullanmışsınız. 2nci için bir şart kullanmamışsınız.
 
Orion1' Alıntı:
İlk şartta <> "" kullanmışsınız. 2nci için bir şart kullanmamışsınız.
Genişletmek için tıkla ...

If Cells(t, "G") <> "" And Cells(t, "H") <> "" Then Cells(t, "J") = Cells(t, "G")

komutunu

If Cells(t, "G") = "" And Cells(t, "H") <> "" Then Cells(t, "J") = Cells(t, "G") şeklinde değiştirdim bu seferde hata vermedi ama harfleri aktarmadı hocam
 
Hata vermediğine göre bir mantık hatası yapmış olabilirsiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst