VBA Create List to Loop ClearContents - vba

I have an overly long block of code that I would like suggestions on how to clean up, because I clearly wrote it in the least efficient way.
Ideally, I am looking for suggestions on how to define the worksheets/ranges that clearcontents will run on as a list, then loop through each and run the script.
How might this best be accomplished?
I appreciate any help you might be able to provide.
Sub ClearContents()
Sheets("Control1").Select
Cells.Select
Selection.ClearContents
Sheets("Control2").Select
Cells.Select
Selection.ClearContents
Sheets("Data").Select
Range("A8").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S1P1").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S1P2").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S1P3").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S1P4").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S1P5").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S1P7").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S2P1").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S2P4").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S2P8").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S3P1").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S4P11").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S5P2").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S1P8").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S1P8").Select
Range("G2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S5P10").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("S5P10").Select
Range("L2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
End Sub

I have some advice to improve your code:
Avoid using .Select. This will slow your macro.
You can clear the contents using:
Worksheets("S5P10").Range("L2").Clear
Use fully qualified names. Ex. Worksheets("Sheet1")
You can write a reusable procedure:
Sub ClearContents(oSheet as String, oRange as String)
Worksheets(oSheet).Range(oRange).Clear
End Sub
Then, you can call your procedure using a loop with an array or just providing Sheet and Range
Call ClearContents("S5P10", "L2")

Sub ClearSomeSheets()
Dim ws as worksheet
For each ws in thisworkbook.worksheets
select case ws.name
case "Control1","Control2",
ws.usedrange.clearcontents
case "Data"
ws.Range(ws.Range("A8"), ws.Range("A8").End(xlToRight).End(xlDown)).ClearContents
case "S1P1","S1P8" 'etc....
ws.Range(ws.Range("A2"), ws.Range("A2").End(xlToRight).End(xlDown)).ClearContents
end select
next ws
end sub

Related

How can I make my macro work in any sheet?

I would like to make my macro work in any sheet and not sure how. The below macro is used on Sheet 5 and Sheet 6 but I'd like it to work in any sheet for example sheet 1 or 2.
There must be a way to do it but I wouldn't know how to do it.
Can anyone help please?
Thanks,
Ceiran
Sheets.Add After:=ActiveSheet
Sheets("2a. Fixed - Cost Forecast").Select
Cells.Select
Selection.Copy
Sheets("Sheet5").Select
ActiveSheet.Paste
Rows("4:4").Select
Range("D4").Activate
Application.CutCopyMode = False
Selection.AutoFilter
Columns("E:AG").Select
Selection.Delete Shift:=xlToLeft
Rows("1:3").Select
Range("A3").Activate
Selection.Delete Shift:=xlUp
Cells.Select
Selection.AutoFilter
Selection.AutoFilter
ActiveSheet.Range("$A$1:$BT$157").AutoFilter Field:=4, Criteria1:="="
Rows("5:5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Rows("1:1").Select
Selection.AutoFilter
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("AB1").Select
ActiveCell.FormulaR1C1 = "Total"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Partner"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range("A1:AB1048575").Select
Range(Selection, Selection.End(xlUp)).Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet5!R1C1:R129C28", Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Sheet6!R3C1", TableName:="PivotTable8", DefaultVersion _
:=xlPivotTableVersion15
Sheets("Sheet6").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable8").PivotFields("Partner")
.Orientation = xlRowField
.Position = 1
End With
End Sub

Paste Values instead of formulas with PasteSpecial - VBANewbie

I am absolutely new to vba. I want to copy certain values in cells from two tabs ("Equities", "Bonds") into a third one ("ZSM") with the following code.
Sub AllesAufEinmal()
Call Spalten
Call Wertpapiere
Call Daten
End Sub
Sub Spalten()
'
' Spalten Macro
'
Sheets("Equities").Select
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("A4").Select
ActiveSheet.Paste
Range("A4").Select
Sheets("Bonds").Select
Range("B4").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ZSM").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
Range("A4").Select
End Sub
Sub Wertpapiere()
'
' Wertpapiere Macro
'
'
Sheets("Equities").Select
Range("A5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ZSM").Select
Range("A5").Select
ActiveSheet.Paste
Range("A5").Select
Sheets("Bonds").Select
Range("A5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ZSM").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Range("A5").Select
End Sub
Sub Daten()
'
' Daten Macro
'
'
Sheets("Equities").Select
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("B5").Select
ActiveSheet.Paste
Sheets("Bonds").Select
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("B5").Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(1, 1).Select
ActiveSheet.Paste
End Sub
That works fine until I wanted to modify the code in a way so that my vba code copies the values from my formulas in the two tabs ("Equities, Bonds") into my third tab ("ZSM"). I really only want the value the formula gives back from formulas like "= J5*K24" to be copied. That did not work even though I modified the code the following way (changes marked with "###here"):
Sub AllesAufEinmal()
Call Spalten
Call Wertpapiere
Call Daten
End Sub
Sub Spalten()
'
' Spalten Macro
'
Sheets("Equities").Select
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("A4").Select
ActiveSheet.Paste
Range("A4").Select
Sheets("Bonds").Select
Range("B4").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ZSM").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
Range("A4").Select
End Sub
Sub Wertpapiere()
'
' Wertpapiere Macro
'
'
Sheets("Equities").Select
Range("A5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ZSM").Select
Range("A5").Select
ActiveSheet.Paste
Range("A5").Select
Sheets("Bonds").Select
Range("A5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ZSM").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Range("A5").Select
End Sub
Sub Daten()
'
' Daten Macro
'
'
Sheets("Equities").Select
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("B5").Select
ActiveSheet.PasteSpecial ###here
Sheets("Bonds").Select
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("B5").Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(1, 1).Select
ActiveSheet.PasteSpecial ###here
End Sub
Any ideas? I read a bit about the PasteSpecial Methode but could not apply it to my problem at this stage.
Thank your for your help! I would really appreciate your support.
EDIT: Screenshots as requested
Attention: The column ISIN should only be there once in tab "ZSM". It should be possible to extend columns and rows.
Using the direct value transfer methods described in your last question, I've come up with this.
Each part of the transfer is labelled so you can split the individual routines apart as needed.
Option Explicit
Sub AllesAufEinmal()
Dim tws As Worksheet
Set tws = Worksheets("ZSM")
Call Spalten(tws)
'Call Wertpapiere(tws)
'Call Daten(tws)
End Sub
Sub Spalten(zsm As Worksheet)
' Spalten Macro
'headers, ISIN and data from from Equities
With Worksheets("Equities")
With .Range(.Cells(.Rows.Count, "A").End(xlUp), .Cells(4, .Columns.Count).End(xlToLeft))
zsm.Cells(4, "A").Resize(.Rows.Count, .Columns.Count) = .Value
End With
End With
'headers from Bonds
With Worksheets("Bonds")
With .Range(.Cells(4, "B"), .Cells(4, .Columns.Count).End(xlToLeft))
zsm.Cells(4, zsm.Columns.Count).End(xlToLeft).Offset(0, 1).Resize(.Rows.Count, .Columns.Count) = .Value
End With
End With
'ISIN from Bonds
With Worksheets("Bonds")
With .Range(.Cells(5, "A"), .Cells(.Rows.Count, "A").End(xlUp))
zsm.Cells(zsm.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(.Rows.Count, .Columns.Count) = .Value
End With
End With
'data from Bonds
With Worksheets("Bonds")
With .Range(.Cells(.Rows.Count, "B").End(xlUp), .Cells(5, .Columns.Count).End(xlToLeft))
zsm.Cells(zsm.Cells(zsm.Rows.Count, "B").End(xlUp).Row, _
zsm.Cells(5, zsm.Columns.Count).End(xlToLeft).Column). _
Offset(1, 1).Resize(.Rows.Count, .Columns.Count) = .Value
End With
End With
End Sub
'Best practice' dictates that you should avoid Select and provide proper parent worksheet references. To this end, I've passed the target worksheet reference to each 'helper' sub procedure as a parameter.
You should use xlPasteValues. Example:
Range("B5").PasteSpecial xlPasteValues
If you prefer formulas you could use xlPasteFormulas.
I strongly advise to read this article on how to avoid using Select:
How to avoid using Select in Excel VBA
You can try replacing those Activesheet.PasteSpecial as:
Selection.PasteSpecial Paste:=xlPasteValues
This will paste your selected range as just values.

Paste values instead of formulas

I want to copy certain values in cells from one tab into another.
Sheets("Equities").Select
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("B5").Select
ActiveSheet.Paste
Sheets("Bonds").Select
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("B5").Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(1, 1).Select
ActiveSheet.Paste
I want to modify the code to also copy the values (I only want the value the formula gives back) from formulas (e.g. "= J5*K24").
I modified the code the following way:
Sheets("Equities").Select
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("B5").Select
ActiveSheet.PasteSpecial ###here
Sheets("Bonds").Select
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("B5").Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(1, 1).Select
ActiveSheet.PasteSpecial ##here
I read a bit about the PasteSpecial method but could not apply it.
Forget the PasteSpecial xlValues and perform a direct value transfer hereby bypassing the clipboard altogether.
dim zsm as worksheet
set zsm = workSheets("ZSM")
with workSheets("Equities")
with .Range(.range(.cells(5, "B"), .cells(.rows.count, "B").end(xlup)), _
.range(.cells(5, "B"), .cells(5, .columns.count).end(xltoleft)))
zsm.cells(5, "B").resize(.rows.count, .columns.count) = .value
end with
end with
with workSheets("Bonds")
with .Range(.range(.cells(5, "B"), .cells(.rows.count, "B").end(xlup)), _
.range(.cells(5, "B"), .cells(5, .columns.count).end(xltoleft)))
zsm.cells(zsm.rows.count, "B").end(xlup).offset(1, 1).resize(.rows.count, .columns.count) = .value
end with
end with
Are you sure that last offset should be offset(1, 1) and not offset(1, 0)?

Code for Multiple Sheet/Active Sheet

i'm currently working on a code that will copy data from one sheet to another (please see below),it currently works on one sheet, but now I want this code to work on multiple sheets or whatever sheet is active. Can you please assist me in modifying this code to work on multiple sheets.
Sub sbCopyRangeToAnotherSheet()
Sheets("Sheet1").Select
Range("A15:E188").Select
Selection.ClearContents
Range("A15").Select
Sheets("FCI").Select
Range("C51").Select
'Copy the data
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Activate the destination worksheet
Sheets("Sheet1").Activate
'Select the target range
Range("A15").Select
'Paste in the target destination
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
End Sub
May be this is what you are looking for, also you can yourself twick the code little bit to suit your requirements.
Sub sbCopyRangeToAnotherSheet()
temp = ActiveSheet.Index
Sheets(temp).Select
Range("A15:E188").Copy
Worksheets("Sheet1").Activate
k = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Range("A" & k + 1).Select ' kindly change the code to suit your paste location
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
modified your code with a loop to go through all the sheets present in workbook.
let me know if this is what was required.
Sub sbCopyRangeToAnotherSheet()
Sheets("Sheet1").Select
Range("A15:E188").Select
Selection.ClearContents
Range("A15").Select
Sheets("FCI").Select
Range("C51").Select
'Copy the data
For Each Sheet In ActiveWorkbook.Sheets
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Activate the destination worksheet
Sheets("Sheet1").Activate
'Select the target range
Range("A15").Select
'Paste in the target destination
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Next
End Sub
as I understand by your code, you want to be able to copy data from any active sheet to FSI Sheet. if this is the case , I have done changes as in below code.
Sub sbCopyRangeToAnotherSheet()
temp = ActiveSheet.Index
Sheets(temp).Select
Range("A15:E188").Select
Selection.ClearContents
Range("A15").Select
'Sheets("FCI").Select
'ActiveSheet.Range("C51").Select
'Copy the data
'For k = 1 To ActiveWorkbook.Worksheets.Count
Worksheets(temp).Activate
Sheets(temp).Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Activate the destination worksheet
Sheets(temp).Activate
'Select the target range
Range("A15").Select
'Paste in the target destination
Sheets("FCI").Select
Range("A15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
'Next
End Sub

Procedure too large error in excel VBA

I am not used to writing code. I normally generate my code via macro and I am facing this issue. Can someone please help me?
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+q
'
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Rules").Select
Range("A2").Select
ActiveSheet.Paste
Columns("A:A").Select
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$307").RemoveDuplicates Columns:=1, Header:=xlYes
Sheets("Input").Select
ActiveWindow.LargeScroll Down:=-14
Range("A1").Select
Cells.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Rules" _
).Range("A1:A2"), Unique:=False
ActiveCell.Offset(1, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Result").Select
Range("A2").Select
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell.Offset(3, 0).Range("A1").Select
Sheets("Rules").Select
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Sheets("Input").Select
Range("A1").Select
Cells.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Rules" _
).Range("A1:A2"), Unique:=False
ActiveCell.Offset(2, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Result").Select
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell.Offset(3, 0).Range("A1").Select
Sheets("Rules").Select
Rows("2:2").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Sheets("Input").Select
Range("A1").Select
Cells.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Rules" _
).Range("A1:A2"), Unique:=False
ActiveCell.Offset(2, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Result").Select
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell.Offset(3, 0).Range("A1").Select
Sheets("Rules").Select
Rows("2:2").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Sheets("Input").Select
Range("A1").Select
Cells.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Rules" _
).Range("A1:A2"), Unique:=False
ActiveCell.Offset(3, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Result").Select
ActiveSheet.Paste
End Sub
I want to repeat these steps 50 times, but I am getting an error message "Procedure too large" when I try to copy/paste it 50 times. Can you please show me how to do this in smaller steps?
Range("A1").Select
Cells.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Rules" _
).Range("A1:A2"), Unique:=False
ActiveCell.Offset(2, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Result").Select
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell.Offset(3, 0).Range("A1").Select
Sheets("Rules").Select
Rows("2:2").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Sheets("Input").Select
Save only the steps that you need to repeat in a macro, say Macro2.
Then create a new Sub like this:
Sub RepeatMacro2
' Beginning steps (will not be repeated)
For i = 1 to 50
Macro2
Next i
' Final steps (will not be repeated)
End Sub
You can copy/paste the first steps (not to be repeated) before the For and the last steps (also not to be repeated) after the Next.
Call RepeatMacro2 using the Macros dialog.