Copy And Paste

[Manuel998]

Hi

need a macro to copy and paste the colums each week(please not this is only a snap of the data I have a lot of these hence the need for a macro)

I would Greatly appreciate your help on this (spreadsheet attached).

Thanks
Manuel

PS i have also listed my ask in the spreadsheet.

 

[AlanSidman]

Option Explicit

Sub Manuel()
    Dim lr As Long
    lr = Range("H" & Rows.Count).End(xlUp).Row
    Dim rng As Range
    Set rng = Range("D2:H" & lr)
    rng.Copy
    Range("C2").PasteSpecial xlPasteValues
End Sub

 

[Manuel998]

Hi Alan,

thanks for this any ideas how i could replicate your code for this worksheet?

Thanks

 

[AlanSidman]

Give this a try:

Option Explicit
   
Sub Manuel()
    Application.ScreenUpdating = False
    Dim lr As Long, i As Long
    lr = Range("C" & Rows.Count).End(xlUp).Row
    For i = 2 To lr - 5
    Dim rng As Range, rng2 As Range
    Set rng = Range("D" & i & ":H" & i + 4)
    Set rng2 = Range("M" & i & ":Q" & i + 4)
    rng.Copy
    Range("C" & i).PasteSpecial xlPasteValues
    rng2.Copy
    Range("L" & i).PasteSpecial xlPasteValues
    i = i + 7
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "complete"
End Sub

 

[Manuel998]

Hi Alan,

I gave the above a try however the only issue is that some of the cells dont get updated (i have attache d these on the spreadsheet marked in red). I would greatly appreciate if you could help me out on this.

Thanks

 

[Manuel998]

I have tried to adjust the columns and rows but not entirely sure why its not picking the middle section of the data in the spreadsheet. I would really appreciate your help on this.

Thanks

 

[AlanSidman]

I found an error in my code. Try this and advise if you still are having issues.

Sub Manuel()
    Application.ScreenUpdating = False
    Dim lr As Long, i As Long
    lr = Range("C" & Rows.Count).End(xlUp).Row
    For i = 2 To lr - 5
    Dim rng As Range, rng2 As Range
    Set rng = Range("D" & i & ":H" & i + 4)
    Set rng2 = Range("M" & i & ":Q" & i + 4)
    rng.Copy
    Range("C" & i).PasteSpecial xlPasteValues
    rng2.Copy
    Range("L" & i).PasteSpecial xlPasteValues
    i = i + 6
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "complete"
End Sub

 

[Manuel998]

Hi Alan,

all works apart for the rows from 51-55 onwards. your help will be greatly appreciated.

Thanks

 

[AlanSidman]

Try changing this line of code

For i = 2 To lr - 5

to

For i = 2 To lr