Can't loop a macro

[Rafa0173]

Hello folks!

I've recorded this macro on Excel 2016 and it has been working perfectly.

Sub Inserir()
'
' Inserir Macro
'
' Atalho do teclado: Ctrl+i
'
    Range("A3:H3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A4:H4").Select
    Selection.Copy
    Range("A3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A4:B4").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.End(xlDown).Select
    ActiveWindow.SmallScroll Down:=16
    Range("C2000").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A2001:H2001").Select
    Selection.ClearContents
    Range("A1").Select
    
End Sub

But my worksheet has 28 sheets, numbered from 2 to 29 and currently I need to run this macro individually in each sheet. So obviously I've tried to make a loop with this macro:

Sub Inserir()
'
' Inserir Macro
'
' Atalho do teclado: Ctrl+i
'
For aba = 2 To 29
    Sheets(aba).Activate
    Range("A3:H3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A4:H4").Select
    Selection.Copy
    Range("A3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A4:B4").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.End(xlDown).Select
    ActiveWindow.SmallScroll Down:=16
    Range("C2000").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A2001:H2001").Select
    Selection.ClearContents
    Range("A1").Select
    Next aba
End Sub

I've tried a lotta things but I simply can't make it work. I'm reciving this error message:

Error '1004':

This won't work because it would move cells in a table on your worksheet.

Any help here? Tks a lot!

[georgiboy]

Difficult to see what it is doing without seeing the spreadsheet but the below may help:

Sub test2()
    Dim ws As Worksheet, aba As Integer
    
    For aba = 2 To 29
        Set ws = Sheets(aba)
        With ws
            .Range("A3:H3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Range("A3:H3").Formula = .Range("A4:H4").Formula
            .Range("A4:B4").Value = .Range("A4:B4").Value
            .Range("C2000").Value = .Range("C2000").Value
            .Range("A2001:H2001").ClearContents
        End With
    Next aba
End Sub

[Rafa0173]

Thanks fou your help georgiboy, but it didn't work. I recived the same error message.

[georgiboy]

What line do you get the error on?

[SamT]

To see which sheet has the problem, insert this line after the For ... 2 to 29

For aba = 2 to 29
   MsgBox aba

[georgiboy]

Not sure it will fix the error you see but thought the code could do with the addition of CStr:

Sub test2()
    Dim ws As Worksheet, aba As Integer
    
    For aba = 2 To 4
        Set ws = Sheets(CStr(aba))
        With ws
            .Range("A3:H3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Range("A3:H3").Formula = .Range("A4:H4").Formula
            .Range("A4:B4").Value = .Range("A4:B4").Value
            .Range("C2000").Value = .Range("C2000").Value
            .Range("A2001:H2001").ClearContents
        End With
    Next aba
End Sub

[Rafa0173]

What line do you get the error on?

.Range("A3:H3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

When aba value was 5. But it was strange, the sheets didn't change at all. It was like the macro didn't to anything.

[Rafa0173]

To see which sheet has the problem, insert this line after the For ... 2 to 29

For aba = 2 to 29
   MsgBox aba

Tks SamT

[georgiboy]

I suspect that sheet could be protected?

If you run the code as below then you should be able to see "Hello World" in cell "A3" on each sheet where it has worked:

Sub test2()
    Dim ws As Worksheet, aba As Integer
    
    For aba = 2 To 4
        Set ws = Sheets(CStr(aba))
        With ws
            .Range("A3:H3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Range("A3") = "Hello World"
'            .Range("A3:H3").Formula = .Range("A4:H4").Formula
'            .Range("A4:B4").Value = .Range("A4:B4").Value
'            .Range("C2000").Value = .Range("C2000").Value
'            .Range("A2001:H2001").ClearContents
        End With
    Next aba
End Sub

Make sure that none of he sheets 2-29 are protected

[Rafa0173]

Not sure it will fix the error you see but thought the code could do with the addition of CStr:

Sub test2()
    Dim ws As Worksheet, aba As Integer
    
    For aba = 2 To 4
        Set ws = Sheets(CStr(aba))
        With ws
            .Range("A3:H3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Range("A3:H3").Formula = .Range("A4:H4").Formula
            .Range("A4:B4").Value = .Range("A4:B4").Value
            .Range("C2000").Value = .Range("C2000").Value
            .Range("A2001:H2001").ClearContents
        End With
    Next aba
End Sub

It worked! Thank you so much georgiboy!!!

[Aussiebear]

Did you physically name your sheets 2 to 29 ( as in the tab name) or are you referring to Sheet2 to Sheet29?

[Rafa0173]

Hi mate!

Yes, my sheets are physically named from 2 to 29. But nevermind, georgiboy solved the problem. Thanks for your reply!