Aktarma makrosu daha kısa yazılabilir mi?

[ilkersan]

Merhaba,

Ekli dosyadaki excel şablonlarına makro ile beri aktarıyorum. Makro 15 ayrı koşula göre çalışıyor. Her koşul için ayrı kod grubu oluşturdum. Aşağıdaki örnekte görüldüğü gibi sadece kırmızı fontlu kod satırında değişiklik yaparak.
Benim merak ettiğin 15 ayrı makro yazmak yerine tek bir makroda aktarım yapacak bir kod yazılabiliyor mi?
Yardım, görüş ve önerileriniz için şimdiden teşekkürler.

Sub aktar()
Application.ScreenUpdating = False
Dim S1 As Worksheet
Dim S2 As Worksheet
Set S1 = Sheets("Formlar") 'sayfa ad değiştir
Set S2 = Sheets("Takip") 'sayfa ad değiştir
's1 veri alınan sayfa
's2 veri yazılan sayfa

S1_son_sat = S1.[b65536].End(3).Row
a = 5
b = 1
For i = 2 To S1_son_sat
If S1.Cells(i, "e") = Range("I4").Value2 Then
'If S1.Cells(i, "B") = "FSC ASIAN HA TECH 5" Then ' teknisyen
S2.Cells(a, "B") = S1.Cells(i, "b")
S2.Cells(a, "c") = S1.Cells(i, "r")
S2.Cells(a, "d") = S1.Cells(i, "ap")
S2.Cells(a, "f") = S1.Cells(i, "au")
S2.Cells(a, "h") = S1.Cells(i, "n")
'S2.Cells(a, "b") = b
b = b + 1
a = a + 1

Else
End If
Next i

'Application.ScreenUpdating = True
'MsgBox " B İ T T İ "
End Sub

 

[PLİNT]

Merhaba
Koşulları "or" ("yada") ile birleştirerek olabilir.

[SIZE="2"][COLOR="red"]If[/COLOR] S1.Cells(i, "e") = Range("I4").Value2 [COLOR="Red"]Or[/COLOR] _
S1.Cells(i, "B") = "FSC ASIAN HA TECH 5" [COLOR="Red"]Or _[/COLOR]
S1.Cells(i, "e") = Range("I4").Value2 [COLOR="red"]Then[/COLOR][/SIZE]

 

[ilkersan]

Sayın PLİNT,
Cevap teşekkürler "or" yapısını kullanamıyorum. Kod sayfamda 15 adet aktarma makrosu var. Aktarım yapılan sayfada 15 adet şablonum her kod şablonda farklı satır aralıklarında veri aktarıyor. Bu yüzden 15 makro oluşturdum. Sanırım başka çözüm yolu yok.

Merhaba
Koşulları "or" ("yada") ile birleştirerek olabilir.

[SIZE="2"][COLOR="red"]If[/COLOR] S1.Cells(i, "e") = Range("I4").Value2 [COLOR="Red"]Or[/COLOR] _
S1.Cells(i, "B") = "FSC ASIAN HA TECH 5" [COLOR="Red"]Or _[/COLOR]
S1.Cells(i, "e") = Range("I4").Value2 [COLOR="red"]Then[/COLOR][/SIZE]

 

[GursoyC]

VBA için "case" yapısını araştırın derim.
bence yapılabilir.

 

[Orion1]

Pragmatik procedure ile çözdüm.
Dosya ektedir.

 

[ilkersan]

Sayın unlimitted
Select Case yapısı da uymuyor.

Sayın Orion1

Cevabınız için teşekkürler.
Pragmatik procedure ilgili detaylı bilgiye nasıl ulaşabilirim.
Anladığım kadarıyla veri aktarılacak satırlar parantez içindekiler.

Sub Düğme3_Tıklat()
Call aktar(5)
Call aktar(36)
Call aktar(67)
Call aktar(98)
Call aktar(129)
Call aktar(160)
Call aktar(191)
Call aktar(222)
Call aktar(253)
Call aktar(284)
Call aktar(315)
Call aktar(346)
Call aktar(377)
Call aktar(408)
Call aktar(439)

Bu prosedürü çalıştırmak için aşağıdaki kod grubu yeterli mi?

Sub aktar(ByRef a As Long)

 

[Orion1]

Düğme3 prosedürünü çalıştırmak yeterli.
oradaki değişkeni aktar prosederünde kullanıyoruz.İlk başlangıç için satır no sudur , onlar.