Need a way to repeat a step x amount of times in VBA - Loop

[MrPink1986]

Hi,

I have a spreadsheet which has a sheet which contains formulas (called 'Formulas') which are based from an input sheet. There will be a variable number of lines within this sheet based on the data in the input sheet.

At the min I have a macro which takes the information on my formulas sheet and pastes the values into format - this sheet in named 'text'.

The next step is to take each of these lines on the text sheet (line by line), copy and paste to the Output sheet while transposing the data. After each paste there needs to be a blank line before the next record can be pasted.

I have my macro doing this however I believe with a loop of some sort this may be more automated. My code at the min below runs for 3 examples - I have 1591 rows today - any help greatly appreciated.

 Sheets("Formulas").Select    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Text").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Output").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A19").Select
    
    Sheets("Text").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Output").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A36").Select
    
    Sheets("Text").Select
    Range("A4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Output").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A53").Select

 

[RoryA]

So there are 18 columns of formulas to copy across? Is that fixed, or could it change in the future?

 

[Fluff]

How about

Sub TransposeData()
   Dim Ws As Worksheet
   Dim Cl As Range
   
   Set Ws = Sheets("Text")
   Sheets("Formulas").UsedRange.Offset(1).Copy
   Ws.Range("A2").PasteSpecial xlPasteValues
   With Sheets("Output")
      For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
         Range(Cl, Cl.End(xlToRight)).Copy
         .Range("A" & Rows.Count).End(xlUp).Offset(2).PasteSpecial , , , True
      Next Cl
   End With
End Sub

 

[MrPink1986]

So there are 18 columns of formulas to copy across? Is that fixed, or could it change in the future?

No its a fixed width which will not change in the future.

 

[MrPink1986]

This has worked a treat - thanks alot.

 

[Fluff]

Glad we could help & thanks for the feedback.
If you're interested this can be done with the "Text" sheet like

Sub TransposeData()
   Dim Ws As Worksheet
   Dim Cl As Range
   
   Set Ws = Sheets("Formulas")
   With Sheets("Output")
      For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
         .Range("A" & Rows.Count).End(xlUp).Offset(2).Resize(18).Value = Application.Transpose(Cl.Resize(, 18))
      Next Cl
   End With
End Sub