Soru alanları otomatik kopyalama

[incsoft]

Detaylı açıklama ektedir arkadaşlar.

Teşekkürler.

 

[bmutlu966]

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.

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

 

[incsoft]

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

 

[bmutlu966]

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

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

 

[incsoft]

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

 

[incsoft]

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

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

hocam yeni hata nedendir acaba?

 

[bmutlu966]

Orijinal dosyanız buysa problemsiz çalışıyor.

 

[incsoft]

Orijinal dosyanız buysa problemsiz çalışıyor.

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.

 

[incsoft]

Orijinal dosyanız buysa problemsiz çalışıyor.

orjinal dosyada sağ tarafta ve aşağıda bulunan yerleri boşaltınca aktarıyor diğer türlü aktarmıyor kafayı yedirdi hocam.

 

[incsoft]

Orijinal dosyanız buysa problemsiz çalışıyor.

 

[incsoft]

Orijinal dosyanız buysa problemsiz çalışıyor.

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.

 

[bmutlu966]

Kodda hata yapmışız. Sanırım şimdi probleminiz çözülecek.

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

 

[incsoft]

Kodda hata yapmışız. Sanırım şimdi probleminiz çözülecek.

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

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

 

[Orion1]

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.

 

[incsoft]

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.

mesela ne gibi hocam? Bu komutla rakamlarla gayet güzel aktarıyor ancak harfli olanlarda hata veriyor.

 

[incsoft]

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.

keşke sizler gibi uzman olabilsem hocam hemen yapacağım ama yapamıyorum

 

[Orion1]

İlk şartta <> "" kullanmışsınız. 2nci için bir şart kullanmamışsınız.

 

[incsoft]

İlk şartta <> "" kullanmışsınız. 2nci için bir şart kullanmamışsınız.

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

 

[Orion1]

Hata vermediğine göre bir mantık hatası yapmış olabilirsiniz.

 

[incsoft]

Hata vermediğine göre bir mantık hatası yapmış olabilirsiniz.

hocam zahmet olmazsa ekteki dosyadan bakabilirmisiniz?