VBA Loop that copy range values then paste. Do to all sheets

[chesterrae]

I created a macro that will copy all the values from each month and paste it to [column AK]. The current code is static with fixed ranges and I force to run the macro (using alt+f8) on every sheet since I have multiple sheets.
I'm trying to find a way that will make my codes shorter and more efficient and that will loop to all the sheets doing the same method.
Could you please help me on how to loop this and have it dynamic?





Here's my code:

Sub AttendaceLogger()
'january
Range("B2:AF2").Copy
Range("AK1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'february
Range("B3:AC3").Copy
Range("AK32").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'march
Range("B4:AF4").Copy
Range("AK60").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'april
Range("B5:AE5").Copy
Range("AK91").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'may
Range("B6:AE6").Copy
Range("AK121").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True


'etc.........
End Sub


Thank you all in advance.

 

[Fluff]

How about

Sub transp()
   Dim ws As Worksheet
   Dim cl As Range
   Dim i As Long, m As Long
   
   For Each ws In Worksheets
      i = 1
      For Each cl In ws.Range("B2:B13")
         m = Day(DateSerial(Year(Date), cl.Row, 1) - 1)
         ws.Range("AK" & i).Resize(m).Value = Application.Transpose(cl.Resize(, m))
         i = i + m
      Next cl
   Next ws
End Sub

 

[chesterrae]

Hi Fluff,

Thank you for the response.
Is there a way that it can also copy the exact cell (including cells colors). Just something like how PasteSpecial xlPasteAll works?

Thank you so much!

How about

Sub transp()
   Dim ws As Worksheet
   Dim cl As Range
   Dim i As Long, m As Long
   
   For Each ws In Worksheets
      i = 1
      For Each cl In ws.Range("B2:B13")
         m = Day(DateSerial(Year(Date), cl.Row, 1) - 1)
         ws.Range("AK" & i).Resize(m).Value = Application.Transpose(cl.Resize(, m))
         i = i + m
      Next cl
   Next ws
End Sub

 

[Fluff]

Try

Sub transp()
   Dim ws As Worksheet
   Dim cl As Range
   Dim i As Long, m As Long
   
   For Each ws In Worksheets
      i = 1
      For Each cl In ws.Range("B2:B13")
         m = Day(DateSerial(Year(Date), cl.Row, 1) - 1)
        cl.Resize(, m).Copy
         ws.Range("AK" & i).PasteSpecial , , , True
         i = i + m
      Next cl
   Next ws
End Sub

 

[chesterrae]

Thank you so much!!!

 

[Fluff]

You're welcome