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!!! :bow:

[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!