Döngü yaratmak

[unur]

Merhaba Arkadaşlar

Epey bir uğraş vererek ve buradaki arkadaşların sayesinde aşağıdaki kodlarla işimi görüyordum.
Acaba bu kodları döngü yaparak oluşturulamazmıydı?

Teşekkürler.


Private Sub CommandButton2_Click()
Dim a, b, c
a = MsgBox("HANGİ KOLONA İŞLEM YAPACAĞINIZI A1 HÜCRESİNE YAZDINIZMI?", vbYesNo + vbCritical + vbDefaultButton2, "DİKKAT")
If a = vbYes Then
Range([A1] & 8 & ":" & [A1] & 67).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Range([A1] & 79 & ":" & [A1] & 138).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
.
.
.
.
.
Range([A1] & 6327 & ":" & [A1] & 6386).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Range([A1] & 6398 & ":" & [A1] & 6457).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Range("d1").Select

b = MsgBox("İŞLEM TAMAMLANDI")
Else
c = MsgBox("İŞLEM İPTAL EDİLDİ", , "UNUR")
End If

End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Private Sub CommandButton2_Click()
a = MsgBox("HANGİ KOLONA İŞLEM YAPACAĞINIZI A1 HÜCRESİNE YAZDINIZMI?", vbYesNo + vbCritical + vbDefaultButton2, "DİKKAT")
If a = vbYes Then
For a = 8 To Range([a1] & 65536).End(3).Row Step 71
Range([A1] & a & ":" & [A1] & a+8)=Range([A1] & 8 & ":" & [A1] & 67).value
MsgBox("İŞLEM TAMAMLANDI")
Else
MsgBox "İŞLEM İPTAL EDİLDİ", , "UNUR"
End If
next
End Sub

 

[unur]

Günaydın;
Levent Bey Else de hata veriyor
hata iletisi else without ıf yazıyor.
Nerede ne yapmam gerekiyor.?

 

[Orion1]

Aşağıdaki gibi denermisiniz?

Private Sub CommandButton2_Click()
a = MsgBox("HANGİ KOLONA İŞLEM YAPACAĞINIZI A1 HÜCRESİNE YAZDINIZMI?", vbYesNo + vbCritical + vbDefaultButton2, "DİKKAT")
If a = vbYes Then
For a = 8 To Range([a1] & 65536).End(3).Row Step 71
Range([A1] & a & ":" & [A1] & a+8)=Range([A1] & 8 & ":" & [A1] & 67).value
MsgBox("İŞLEM TAMAMLANDI")
Else
MsgBox "İŞLEM İPTAL EDİLDİ", , "UNUR"
[COLOR="Red"][B]next
End If[/B][/COLOR]
End Sub

 

[unur]

Aynı hatayı veriyor malesef

 

[Orion1]

evet yanlış yapmışım.
Aşağıdaki gibi deneyiniz.

Private Sub CommandButton2_Click()
a = MsgBox("HANGİ KOLONA İŞLEM YAPACAĞINIZI A1 HÜCRESİNE YAZDINIZMI?", vbYesNo + vbCritical + vbDefaultButton2, "DİKKAT")
If a = vbYes Then
For a = 8 To Range([a1] & 65536).End(3).Row Step 71
Range([A1] & a & ":" & [A1] & a+8)=Range([A1] & 8 & ":" & [A1] & 67).value
MsgBox("İŞLEM TAMAMLANDI")
next
[COLOR="Red"][B]Else
MsgBox "İŞLEM İPTAL EDİLDİ", , "UNUR"[/B][/COLOR]
End If
End Sub

 

[unur]

İlginize Teşekkürler Orion2
İlk başta yazmış olduğum (kullandığım kodlar&#305 incelermisiniz.(oraya ilk iki ve son iki kodları gönderdim) Kod hata varmiyor ama işlem tamamlandı uyarısı her işlemden sonra çıkıyor.

 

[Orion1]

İlginize Teşekkürler Orion2
İlk başta yazmış olduğum (kullandığım kodlar&#305 incelermisiniz.(oraya ilk iki ve son iki kodları gönderdim) Kod hata varmiyor ama işlem tamamlandı uyarısı her işlemden sonra çıkıyor.

Benim düzenlediğim kodlarda evet butonuna basarsanız işlem yapılıyor ve işlem tamamlandı mesajı çıkıyor.Hayır butonuna basarsanız işlem iptal edildi mesajı çıkıyor.

 

[unur]

Haklısınız Orion2 ama ben bu işlemi

Range([A1] & 6398 & ":" & [A1] & 6457).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Buraya kadar yapmak istiyorum.
tekrar bir bakarmısınız benmi yanlış anlatıyorum.

 

[Orion1]

Haklısınız Orion2 ama ben bu işlemi

Range([A1] & 6398 & ":" & [A1] & 6457).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Buraya kadar yapmak istiyorum.
tekrar bir bakarmısınız benmi yanlış anlatıyorum.

Yukarıdaki yazdığınız kodları Sayın Leventm kısaltarak düzenledi.
Ve o duruma göre mesaj vermesi düzenlenmiş durumda.
Şimdi siz yine ilk mesajda verdiğiniz kodlaramı dönüş yapmak istiyorsunuz.

 

[unur]

Merhaba;
Sayın orion kodlar aşağıdaki gibi olunca çalışıyor.Ancak benim istediğim şeyi yapmıyor.
Denemelerde bulunarak kodların ne işe yaradığını çözmeye çalıştım.A8 ile a67 deki değerleri aşağılara aynen kopyalıyor.
Benim istediğim ise a8 den başlayarak 59 karakter seçip, seçtiği yerin değerlerini aynı yere yapıştıracak 11 karakter atlayacak ondan sonraki 59 karakteri kopyalayıp gene olduğu yere değerleri yapıştıracak. Bu döngü tabloların sonuna kadar devam edicek.
Anlatması biraz güç ama umarım anlaşılır bir şekilde anlatabilmişimdir.

Private Sub CommandButton1_Click()
a = MsgBox("HANGİ KOLONA İŞLEM YAPACAĞINIZI A1 HÜCRESİNE YAZDINIZMI?", vbYesNo + vbCritical + vbDefaultButton2, "DİKKAT")
If a = vbYes Then
For a = 8 To Range([A1] & 65536).End(3).Row Step 71
Range([A1] & a & ":" & [A1] & a + 58) = Range([A1] & 8 & ":" & [A1] & 67).Value
Next
MsgBox ("İŞLEM TAMAMLANDI")
Else
MsgBox "İŞLEM İPTAL EDİLDİ", , "UNUR"
End If
End Sub

 

[unur]

Günaydın; Bu konuda fikri olan arkadaş yokmu?

 

[ceyrek]

Range([A1] & a & ":" & [A1] & a + 58) = Range([A1] & a & ":" & [A1] & a+ 59).Value
Şeklinde denermisiniz?

 

[unur]

Çok teşekkür ederim ceyrek bey,
evet istediğim gibi oldu şimdi