宏根据特定单元格的值向左重复复制粘贴

Question

I am completely new to VBA. I have a spreadsheet that needs to align data to dates. The dates change dynamically as the sheet is updated.

Basically the macro below moves the data over one column to the left (replaces column J with data from column K to Q) and clears the existing data from Q. the data is a combination of just values, formulas and formatting. The below macro works however I need it to repeat itself the number of times whatever the value is in cell E3 (this cell will take into account time lag to realign the data).

So basically can someone please help this repeat this macro based on the value in E3 if it is greater then 1. Also I get a bug clearing the cells after it is repeated once because the cells are already clear so maybe run the first part as is then adding an IF ("E3") > 1 then moving Range("K6:P500") the number of times in E3. I have tried to do this but I don't know how to get the repeat and the IF I put together didn't really work.

Thanks again so much for any help of suggestions!

' Week_update Macro
'
' Keyboard Shortcut: Ctrl+Shift+W
'
    Range("K6:Q500").Select
    Selection.Copy
    Range("J6").Select
    ActiveSheet.PasteSpecial Format:=2, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Range("Q6").Select
    Range("Q6:Q500").Select
    Selection.SpecialCells(xlCellTypeConstants, 1).Select
Selection.ClearContents
End Sub

Answer 1

Assuming what you mean is to move the whole of columns the number contained in E3 rows to the right, this will do what you wanted.

It's easier to work with moving ranges if you use Cells notation rather than A1:B1 .

Sub Week_update()
Dim i As Long
    i = Range("E6")
    If i > 0 Then
        ' Copy range
        Range(Cells(6, 10 + i), Cells(500, 18)).Copy
        ' Select range the same size but i columns to the right
        Range(Cells(6, 10), Cells(500, 18 - i)).Select
        ' Paste special
        ActiveSheet.PasteSpecial Format:=2, Link:=1, _
            DisplayAsIcon:=False, IconFileName:=False
        ' Clear i columns on the right
        Range(Cells(6, 18 - i), Cells(500, 18)).ClearContents
    End If
End Sub

This is if you actually need the PasteSpecial . If not then you can just use:

Sub Week_update()
Dim i As Long
    i = Range("E6")
    If i > 0 Then
        ' Copy range i columns to the left
        Range(Cells(6, 11), Cells(500, 17)).Copy( _
            Range(Cells(6, 11 - i), Cells(500, 17 - i)))
        ' Clear i columns on the right
        Range(Cells(6, 17 - i), Cells(500, 17)).ClearContents
    End If
End Sub