• DİKKAT

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

makroda if formülü düzenlemek

Katılım
4 Mayıs 2007
Mesajlar
234
Excel Vers. ve Dili
office 2007 64 bit
office 2010 64 bit
If Sheets("sheet3").Range("O1") = Sheets("sheet1").Range("G5") Then
Sheets("sheet2").Range("J5").ClearContents
Sheets("sheet1").Range("c5").Copy
Sheets("sheet3").Range("b5").PasteSpecial xlPasteValues
Sheets("sheet1").Range("H5").Copy
Sheets("sheet3").Range("E5").PasteSpecial xlPasteValues
Sheets("sheet1").Range("I5").Copy
Sheets("sheet3").Range("C5").PasteSpecial xlPasteValues
Sheets("sheet1").Range("J5").Copy
Sheets("sheet3").Range("D5").PasteSpecial xlPasteValues
Sheets("sheet1").Range("G5").Copy
Sheets("sheet3").Range("F5").PasteSpecial xlPasteValues
Sheets("sheet2").Range("O5").Copy
Sheets("sheet3").Range("K5").PasteSpecial xlPasteValues
Sheets("sheet1").Range("c5:J5").ClearContents

End If
If Sheets("sheet3").Range("O1") <> Sheets("sheet1").Range("G5") Then
End If
End Sub



bu formülü aşşagıdaki hücrelerde de çalışacak şekilde düzenlemek istiyorum
Sheet1
G5,G6,G7,G8,G9,G10,G11,G12,G13,G14
G16,G17,G18,G19,G20,G21,G22,G23,G24,G25
G27,G28,G29,G30,G31,G32,G33,G34,G35,G36
 
Sub test()
Dim x, y, z As Integer
For x = 5 To 14
x = x + 1
If Sheets("sheet3").Range("O1") = Sheets("sheet1").Range("Gx") Then
Sheets("sheet2").Range("Jx").ClearContents
Sheets("sheet1").Range("cx").Copy
Sheets("sheet3").Range("bx").PasteSpecial xlPasteValues
Sheets("sheet1").Range("Hx").Copy
Sheets("sheet3").Range("Ex").PasteSpecial xlPasteValues
Sheets("sheet1").Range("Ix").Copy
Sheets("sheet3").Range("Cx").PasteSpecial xlPasteValues
Sheets("sheet1").Range("Jx").Copy
Sheets("sheet3").Range("Dx").PasteSpecial xlPasteValues
Sheets("sheet1").Range("Gx").Copy
Sheets("sheet3").Range("Fx").PasteSpecial xlPasteValues
Sheets("sheet2").Range("Ox").Copy
Sheets("sheet3").Range("Kx").PasteSpecial xlPasteValues
Sheets("sheet1").Range("cx:Jx").ClearContents
End If
If Sheets("sheet3").Range("O1") <> Sheets("sheet1").Range("Gx") Then
End If
Next x
For y = 16 To 25
If Sheets("sheet3").Range("O1") = Sheets("sheet1").Range("Gy") Then
Sheets("sheet2").Range("Jy").ClearContents
Sheets("sheet1").Range("cy").Copy
Sheets("sheet3").Range("by").PasteSpecial xlPasteValues
Sheets("sheet1").Range("Hy").Copy
Sheets("sheet3").Range("Ey").PasteSpecial xlPasteValues
Sheets("sheet1").Range("Iy").Copy
Sheets("sheet3").Range("Cy").PasteSpecial xlPasteValues
Sheets("sheet1").Range("Jy").Copy
Sheets("sheet3").Range("Dy").PasteSpecial xlPasteValues
Sheets("sheet1").Range("Gy").Copy
Sheets("sheet3").Range("Fy").PasteSpecial xlPasteValues
Sheets("sheet2").Range("Oy").Copy
Sheets("sheet3").Range("Ky").PasteSpecial xlPasteValues
Sheets("sheet1").Range("cy:Jy").ClearContents
End If
If Sheets("sheet3").Range("O1") <> Sheets("sheet1").Range("Gy") Then
End If
Next y
For z = 27 To 36
If Sheets("sheet3").Range("O1") = Sheets("sheet1").Range("Gz") Then
Sheets("sheet2").Range("Jz").ClearContents
Sheets("sheet1").Range("cz").Copy
Sheets("sheet3").Range("bz").PasteSpecial xlPasteValues
Sheets("sheet1").Range("Hz").Copy
Sheets("sheet3").Range("Ez").PasteSpecial xlPasteValues
Sheets("sheet1").Range("Iz").Copy
Sheets("sheet3").Range("Cz").PasteSpecial xlPasteValues
Sheets("sheet1").Range("Jz").Copy
Sheets("sheet3").Range("Dz").PasteSpecial xlPasteValues
Sheets("sheet1").Range("Gz").Copy
Sheets("sheet3").Range("Fz").PasteSpecial xlPasteValues
Sheets("sheet2").Range("Oz").Copy
Sheets("sheet3").Range("Kz").PasteSpecial xlPasteValues
Sheets("sheet1").Range("cz:Jz").ClearContents
End If
If Sheets("sheet3").Range("O1") <> Sheets("sheet1").Range("Gz") Then
End If
Next z
End Sub




Daha kısası var ama şimdilik bu kadarı da yeter sanırım.

Kolay gelsin.
 
yapam&#305;yorum yard&#305;mc&#305; olacak biri var m&#305; aceba
 
olmadi bunu butona ekledigimde çalışmıyor
runtime error veriyor ve bu formül sarı oluyor If Sheets("sheet3").Range("O1") = Sheets("sheet1").Range("Gx") Then
 
olmadi bunu butona ekledigimde çalışmıyor
runtime error veriyor ve bu formül sarı oluyor If Sheets("sheet3").Range("O1") = Sheets("sheet1").Range("Gx") Then

Range("Gx") olan alanları

Range("G"&x) olarak değiştirin

yani x li alanları ("sütun"&X) olarak ayarlayın.
 
Geri
Üst