Arkadaşlar aşşagıdakı gibi bir makro yazdım fakat d37 hücresi dolu ıse d38-d39-d40-d41 hücrelerinden birine sıra ile kaydırmasını istiyorum.
Sub atama()
'
' atama Makro
' Makro ömer tarafından 13.06.2011 tarihinde kaydedildi.
'
'
Range("R9:W9,Y9:AA9").Select
Range("Y9").Activate
Selection.Copy
ActiveWindow.SmallScroll Down:=3
Range("D37:L37").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=6
Range("I38").Select
ActiveWindow.SmallScroll Down:=-6
Range("Q9:AA9").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("L29").Select
ActiveWindow.SmallScroll Down:=6
Range("D37").Select
Selection.Copy
Sheets("Sayfa3").Select
Range("E24").Select
Cells.Find(What:="D0103", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range("B5").Select
Sheets("Sayfa1").Select
Range("C37").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sayfa3").Select
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Sayfa1").Select
Range("L30").Select
End Sub
Sub atama()
'
' atama Makro
' Makro ömer tarafından 13.06.2011 tarihinde kaydedildi.
'
'
Range("R9:W9,Y9:AA9").Select
Range("Y9").Activate
Selection.Copy
ActiveWindow.SmallScroll Down:=3
Range("D37:L37").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=6
Range("I38").Select
ActiveWindow.SmallScroll Down:=-6
Range("Q9:AA9").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("L29").Select
ActiveWindow.SmallScroll Down:=6
Range("D37").Select
Selection.Copy
Sheets("Sayfa3").Select
Range("E24").Select
Cells.Find(What:="D0103", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range("B5").Select
Sheets("Sayfa1").Select
Range("C37").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sayfa3").Select
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Sayfa1").Select
Range("L30").Select
End Sub
