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

chesterrae

Board Regular
Joined
Dec 23, 2015
Messages
51
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.
 

Some videos you may like

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,055
Office Version
  1. 365
Platform
  1. Windows
How about
Code:
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

Board Regular
Joined
Dec 23, 2015
Messages
51
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
Code:
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
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,055
Office Version
  1. 365
Platform
  1. Windows
Try
Code:
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,055
Office Version
  1. 365
Platform
  1. Windows
You're welcome
 

Watch MrExcel Video

Forum statistics

Threads
1,108,581
Messages
5,523,710
Members
409,532
Latest member
Lmfacc

This Week's Hot Topics

Top