Copy & Looping VBA code

[19ant]

Hi,

I have a workbook with other 100 sheets. Each sheet is identical; consists of 2 columns with the 2nd column to be copied and transposed into a mastersheet. I have created the macro to copy & transpose but cannot get the loop or repeat instruction correct. From reading many threads and other articles, it seems like a few simple lines of code but....not having success! Appreciate help and guidance.

 

[kelly mort]

Get the code you have posted so we can help you with the loop. Thanks

 

[MrAutomation]

Put up your code and describe exactly what errors/issues you are having. It's impossible to help otherwise.
Thanks!

 

[19ant]

Tks for your quick response. Code is below:

Sub Transpose()
'
' Transpose Macro
'


'
Sheets("Clean Template (157)").Select
Range("D2:D120").Select
Selection.Copy
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
Range("B4").Select
Sheets("Clean Template (156)").Select
Range("D2:D120").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
Range("B5").Select
Sheets("Clean Template (155)").Select
ActiveWindow.SmallScroll Down:=-87
Range("D2:D120").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
End Sub

 

[19ant]

My code is below. No errors with the copy&transpose code, I cannot get a loop to work.
Tks

Sub Transpose()
'
' Transpose Macro
'


'
Sheets("Clean Template (157)").Select
Range("D2:D120").Select
Selection.Copy
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
Range("B4").Select
Sheets("Clean Template (156)").Select
Range("D2:D120").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
Range("B5").Select
Sheets("Clean Template (155)").Select
ActiveWindow.SmallScroll Down:=-87
Range("D2:D120").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
End Sub

 

[MARK858]

Change the numbers in red to suit.

Sub Transpose()
    Dim i As Long
    Application.ScreenUpdating = False
    
    For i = [COLOR="#FF0000"]157[/COLOR] To [COLOR="#FF0000"]155[/COLOR] Step -1
        Sheets("Clean Template (" & i & ")").Range("D2:D120").Copy
        Sheets("Sheet3").Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial _
                Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
    Next
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

 

[19ant]

Tks Mark. A novice when it comes to macros but learning on the run! Copied your suggestion and came up with the following (bold code = debug issue)

Runtime error 9, "Subscript out of range"

For i = 157 To 1 Step -1
Sheets("Clean Template (" & i & ")").Range("D2:D120").Copy
Sheets("Sheet3").Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats, Transpose:=True

 

[MARK858]

You get that error when the sheet name's don't match the code.

Your sheets tabs names need to be exactly as below including any spacing....

Clean Template (157)
Clean Template (156)
Clean Template (155)

and obviously if any of the sheet names don't exist you will get the same error.

 

[19ant]

Thanks Mark. Struggling a little unfortunately. All my sheets are named Clean Template(155) all the way down to Clean Template, and then pulling all data into Sheet1. Can you assist with the code; I'm not sure of the ("& i &").

And why sheets and not worksheets, or does it not matter?

Appreciate your time.

 

[MARK858]

There is a gap between

Clean Template (157)

the words and before the bracket in my (and your) code but not before the bracket in your last post.
Which is correct? As I stated it must be an exact match.

Sheets includes chart sheets as well as worksheets (+ a few old things).
Worksheets is part of the Sheets collection.