Excel VBA special loop through worksheets

[tchatch]

Hi there,

I am trying to select informations from sheets 2 to 50. (They do not necessarily exist, I just want the code to run throught all the sheets if I have created a sheet of that name) and paste it to the first sheet of my Workbook.

What I want is for the MAcro to pick stuff from that sheet and then paste it from to the sheet called Factures. There are a few ranges to copy and paste to this Factures sheet, and then , I want the Macro to go to the next sheet in the workbook and copy the same ranges and paste it on that same Factures sheet, but 10 rows lower. And on and on until there's no more Sheets to be found.

I've tried this code...

Sub factures()

Dim i As Integer, m As Integer
i = 2 to 50
m = 5

For i = 2 To 50

Sheets("i").Select
Range("C14:C23").Select
Selection.Copy
Sheets("Factures").Select
Cells(m, 9).Select
Selection.PasteSpecial xlPasteFormulas

Sheets("i").Select
Range("D14:H23").Select
Selection.Copy
Sheets("Facture").Select
Range(Cells(m, 4), Cells(m, 8)).Select
Selection.PasteSpecial xlPasteFormulas


Sheets("i").Select
Range("I14:I23").Select
Selection.Copy
Sheets("Factures").Select
Cells(m, 10).Select
Selection.PasteSpecial xlPasteFormulas

Sheets("i").Select
Range("I3:J3").Select
Selection.Copy
Sheets("Factures").Select
Range(Cells(m + 3, 1), Cells(m + 3, 2)).Select
Selection.PasteSpecial xlPasteFormulas

Sheets("i").Select
Range("I4:J4").Select
Selection.Copy
Sheets("Factures").Select
Range(Cells(m + 5, 1), Cells(m + 5, 2)).Select
Selection.PasteSpecial xlPasteFormulas

m = m + 10

Next i

End Sub

And it dosen't work.
Any ideas?!?

Cheers,

 

[Norie]

So you want to gather data from every sheet in the workbook other than the 'Fractures' worksheet which is where the data will go?

Try this.

Sub factures()
Dim wsFractures As Worksheet
Dim ws As Worksheet
Dim m As Long

    m = 5

    Set wsFractures = ActiveWorkbook.Sheets("Fractures")

    For Each ws In ActiveWorkbook.Sheets

        If Not ws Is wsFractures Then
            With ws
                .Range("C14:C23").Copy
                wsFractures.Cells(m, 9).PasteSpecial xlPasteFormulas
                .Range("D14:H23").Copy
                wsFractures.Cells(m, 4).PasteSpecial xlPasteFormulas
                .Range("I14:I23").Copy
                wsFractures.Cells(m, 10).PasteSpecial xlPasteFormulas
                .Range("I3:J3").Copy
                wsFractures.Cells(m + 3, 1).PasteSpecial xlPasteFormulas
                .Range("I4:J4").Copy
                wsFractures.Cells(m + 5, 1).PasteSpecial xlPasteFormulas
            End With
        End If
    Next ws

End Sub

 

[tchatch]

Yes, That's exactly what I want!

But that wont work either.

 

[Norie]

How does it not work?

 

[tchatch]

In fact it does... there was only an error in the writting of a word. I did have to mess a bit with the m=m+10 but everything is fine now!
Thank you so much Norie!