Looping through worksheets fails

[Network19]

Hi there,

I have been coding for a while so know the basics fairly well. I have, however come across an issue (Code is posted below).

I am trying to write a macro where it will create a new sheet, name it and do some basic stuff but then i want it to loop through any other worksheets available in the workbook and copy the used range there and paste it in the newly created sheet in order.

Theoretically, i would ask it to offset but i have been unsuccessful. I would appreciate any help with the code and perhaps guidance as to where I've gone wrong.

Many thanks


Code:

Sub FeeStatement()
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Consolidated Fee Statement"
Worksheets("Consolidated Fee Statement").Range("A1").Value = "Insert Name"
Worksheets("Consolidated Fee Statement").Range("A1").Font.Bold = True
Worksheets("Consolidated Fee Statement").Range("A2").Value = "Fee Statement"
Worksheets("Consolidated Fee Statement").Range("A3").Value = Date
Worksheets("Consolidated Fee Statement").Range("A3").Select
Selection.Copy
Worksheets("Consolidated Fee Statement").Range("A3").PasteSpecial xlPasteValues
Dim i As Worksheet
For Each i In ActiveWorkbook.Sheets
If ws.Name <> "Consolidated Fee Statement" Then
ws.Activate
i.UsedRange("A1:M5").Select
Selection.Copy
Worksheets("Consolidated Fee Statement").Range("A10" & Count).PasteSpecial xlPasteValues
Else: MsgBox "Error"
End If
Next i
End Sub

 

[Fluff]

Hi, welcome to the board.
If you only want to copy A1:M5 to the new sheet try

Sub FeeStatement()

    Dim Ws As Worksheet
    
Application.ScreenUpdating = False
    Sheets(1).Select
    Worksheets.Add
    Sheets(1).Name = "Consolidated Fee Statement"
    With Sheets(1)
        .Range("A1").Value = "Insert Name"
        .Range("A1").Font.Bold = True
        .Range("A2").Value = "Fee Statement"
        .Range("A3").Value = Date
        For Each Ws In Worksheets
            If Ws.Name <> "Consolidated Fee Statement" Then
                Ws.Range("A1:M5").copy .Range("A" & Rows.Count).End(xlUp).Offset(1)
            End If
        Next Ws
    End With
End Sub

 

[Network19]

Hi, many thanks for your response. I put A1:M5 because used range didnt work. I essentially want it to copy whatever range used in each sheet and paste it in the master sheet

 

[Network19]

By the way, thank you so much for the code, i dont know how to thank you!

 

[Fluff]

ok, try this

Sub FeeStatement()

    Dim Ws As Worksheet
    Dim ShtExist As Boolean
    
Application.ScreenUpdating = False

    On Error Resume Next
    ShtExist = (Sheets("Consolidated Fee Statement").Name) = ("Consolidated Fee Statement")
    On Error GoTo 0
    If ShtExist Then
        MsgBox "Sheet ""Consolidated Fee Statement"" already exists"
        Exit Sub
    End If
    Worksheets.Add before:=Sheets(1)
    Sheets(1).Name = "Consolidated Fee Statement"
    With Sheets(1)
        .Range("A1").Value = "Insert Name"
        .Range("A1").Font.Bold = True
        .Range("A2").Value = "Fee Statement"
        .Range("A3").Value = Date
        For Each Ws In Worksheets
            If Ws.Name <> "Consolidated Fee Statement" Then
                Ws.UsedRange.copy .Range("A" & Rows.Count).End(xlUp).Offset(1)
            End If
        Next Ws
    End With
End Sub

I've also put in a check to see if the new sheet already exists

 

[Network19]

ok, try this

Sub FeeStatement()

    Dim Ws As Worksheet
    Dim ShtExist As Boolean
    
Application.ScreenUpdating = False

    On Error Resume Next
    ShtExist = (Sheets("Consolidated Fee Statement").Name) = ("Consolidated Fee Statement")
    On Error GoTo 0
    If ShtExist Then
        MsgBox "Sheet ""Consolidated Fee Statement"" already exists"
        Exit Sub
    End If
    Worksheets.Add before:=Sheets(1)
    Sheets(1).Name = "Consolidated Fee Statement"
    With Sheets(1)
        .Range("A1").Value = "Insert Name"
        .Range("A1").Font.Bold = True
        .Range("A2").Value = "Fee Statement"
        .Range("A3").Value = Date
        For Each Ws In Worksheets
            If Ws.Name <> "Consolidated Fee Statement" Then
                Ws.UsedRange.copy .Range("A" & Rows.Count).End(xlUp).Offset(1)
            End If
        Next Ws
    End With
End Sub

I've also put in a check to see if the new sheet already exists

Thank you so much! I really appreciate this. I have been stuck on this for a whole day! You are a legend

 

[Fluff]

Glad to help & thanks for the feedback