- Katılım
- 22 Mayıs 2009
- Mesajlar
- 1,017
- Excel Vers. ve Dili
- Office 2003
Sub Arşive_Aktar()
ss = Sheets("ARŞİV").[B5000].End(3).Row + 1
With Sheets("ARŞİV")
.Cells(ss, 1).Value = ss - 1
.Cells(ss, 2).Value = Sheets("YAZI").Range("D7").Value
.Cells(ss, 3).Value = Sheets("YAZI").Range("L7").Value
.Cells(ss, 4).Value = Sheets("YAZI").Range("D8").Value
.Cells(ss, 5).Value = Sheets("YAZI").Range("A11").Value
.Cells(ss, 6).Value = Sheets("YAZI").Range("A12").Value
.Cells(ss, 7).Value = Sheets("YAZI").Range("D14").Value
.Cells(ss, 8).Value = Sheets("YAZI").Range("A16").Value
.Cells(ss, 9).Value = Sheets("YAZI").Range("D18").Value
.Cells(ss, 10).Value = Sheets("YAZI").Range("U22").Value
.Cells(ss, 11).Value = Sheets("YAZI").Range("U23").Value
.Cells(ss, 12).Value = Sheets("YAZI").Range("U24").Value
.Cells(ss, 13).Value = Sheets("YAZI").Range("E27").Value
.Cells(ss, 14).Value = Sheets("YAZI").Range("E28").Value
.Cells(ss, 15).Value = Sheets("YAZI").Range("E29").Value
.Cells(ss, 16).Value = Sheets("YAZI").Range("E30").Value
.Cells(ss, 17).Value = Sheets("YAZI").Range("E32").Value
.Cells(ss, 18).Value = Sheets("YAZI").Range("E33").Value
.Cells(ss, 19).Value = Sheets("YAZI").Range("E34").Value
.Cells(ss, 20).Value = Sheets("YAZI").Range("A40").Value
.Cells(ss, 21).Value = Sheets("YAZI").Range("A41").Value
.Cells(ss, 22).Value = Sheets("YAZI").Range("A42").Value
MsgBox "AKTARIM GERÇEKLEŞTİ ", vbInformation, "KÜLTÜR"
End With
End Sub
Selamün Aleyküm.
Yukarıda ki Makroyu bana Ömer Abim vermişti.Çalışmasında bir sıkıntı yok.
Yalnız Aktarırken 8 puntosunda aktarmak istiyorum.
Bu şekilde bu kodu nasıl düzenleyebilirim.
Yardımcı olabilir misiniz?
Teşekkür Ederim
ss = Sheets("ARŞİV").[B5000].End(3).Row + 1
With Sheets("ARŞİV")
.Cells(ss, 1).Value = ss - 1
.Cells(ss, 2).Value = Sheets("YAZI").Range("D7").Value
.Cells(ss, 3).Value = Sheets("YAZI").Range("L7").Value
.Cells(ss, 4).Value = Sheets("YAZI").Range("D8").Value
.Cells(ss, 5).Value = Sheets("YAZI").Range("A11").Value
.Cells(ss, 6).Value = Sheets("YAZI").Range("A12").Value
.Cells(ss, 7).Value = Sheets("YAZI").Range("D14").Value
.Cells(ss, 8).Value = Sheets("YAZI").Range("A16").Value
.Cells(ss, 9).Value = Sheets("YAZI").Range("D18").Value
.Cells(ss, 10).Value = Sheets("YAZI").Range("U22").Value
.Cells(ss, 11).Value = Sheets("YAZI").Range("U23").Value
.Cells(ss, 12).Value = Sheets("YAZI").Range("U24").Value
.Cells(ss, 13).Value = Sheets("YAZI").Range("E27").Value
.Cells(ss, 14).Value = Sheets("YAZI").Range("E28").Value
.Cells(ss, 15).Value = Sheets("YAZI").Range("E29").Value
.Cells(ss, 16).Value = Sheets("YAZI").Range("E30").Value
.Cells(ss, 17).Value = Sheets("YAZI").Range("E32").Value
.Cells(ss, 18).Value = Sheets("YAZI").Range("E33").Value
.Cells(ss, 19).Value = Sheets("YAZI").Range("E34").Value
.Cells(ss, 20).Value = Sheets("YAZI").Range("A40").Value
.Cells(ss, 21).Value = Sheets("YAZI").Range("A41").Value
.Cells(ss, 22).Value = Sheets("YAZI").Range("A42").Value
MsgBox "AKTARIM GERÇEKLEŞTİ ", vbInformation, "KÜLTÜR"
End With
End Sub
Selamün Aleyküm.
Yukarıda ki Makroyu bana Ömer Abim vermişti.Çalışmasında bir sıkıntı yok.
Yalnız Aktarırken 8 puntosunda aktarmak istiyorum.
Bu şekilde bu kodu nasıl düzenleyebilirim.
Yardımcı olabilir misiniz?
Teşekkür Ederim
