Bir hücredeki değere göre başka alana veri aktarmak

[mehce]

Merhabalar butona tıkladığımda (eğer A1=OCAK ise H4:H8 hücrelerindeki değerleri R4:R8 e A1=ŞUBAT ise H4:H8 hücrelerindeki değerleri S4:S8 e .......A1=ARALIK ise H4:H8 hücrelerindeki değerleri AC4:AC8 e değerleri yapıştır) yapabilecek bir makro yazılabilir mi?Teşekkürler

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub AKTAR()
    Dim AYLAR As Variant, X As Byte
    
    If Range("A1") = "" Then
        MsgBox "Lütfen veri girişi yapınız !", vbExclamation
        Exit Sub
    End If
    
    AYLAR = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
    
    For X = 0 To 11
        If UCase(Replace(Replace(Range("A1"), "i", "İ"), "ı", "I")) = AYLAR(X) Then
        Range(Cells(4, X + 18), Cells(8, X + 18)).Value = Range("H4:H8").Value
        Exit For
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub