Loop Functionality

[excel_userss]

Hi All
I would like to create a macro where i can paste Columns of Option, Strike and Expiry in respective sheets on the left. I have written a macro. please advice the necessary changes

Sheet1	Option	Strike	Expiry
NIkit	c	11200	27-Jun-19
sandeep	P	11300	27-Jun-19
Shraddha	c	11400	27-Jun-19
NAyan	C	11500	27-Jun-19
sansbin	P	11600	27-Jun-19

<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>
</tbody>

Sub Macro1()'Sub SearchSheetName()
Dim xName As String
For m = 2 To Range("g1")
xName = Worksheets("sheet1").Range("A" & m)
Range(("B" & m), ("D" & m)).Copy
Worksheets(xName).Select
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).PasteSpecial

'Selection.Value = Worksheets("sheet1").Range(("B" & m), ("c" & m))
Next m
End Sub

 

[excel_userss]

consider Range("G1")=6.
BAsically there are 6 sheets in workbook

 

[Snakehips]

Like...

Sub Macro1() 'Sub SearchSheetName()
Dim xName As String
For m = 2 To 6
xName = Worksheets("Sheet1").Range("A" & m)
Range(("B" & m), ("D" & m)).Copy
Worksheets(xName).Select
[COLOR=#0000ff]ActiveSheet.[/COLOR]Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).PasteSpecial
Next m
[COLOR=#0000ff]Worksheets("Sheet1").Select[/COLOR]
[COLOR=#0000ff]Application.CutCopyMode = False[/COLOR]
End Sub

Or preferably avoid copy paste and all the associated selections......

Sub Macro2() 'Sub SearchSheetName()
Dim xName As String
On Error GoTo Quit
For m = 2 To 6
xName = Worksheets("Sheet1").Range("A" & m)
With Worksheets(xName)


NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & NextRow & ":C" & NextRow).Value = Sheets("Sheet1").Range("B" & m & ":D" & m).Value
End With
Next m
Quit:
End Sub

Hope that helps but please do not make duplicate posts.

 

[excel_userss]

Like...

Sub Macro1() 'Sub SearchSheetName()
Dim xName As String
For m = 2 To 6
xName = Worksheets("Sheet1").Range("A" & m)
Range(("B" & m), ("D" & m)).Copy
Worksheets(xName).Select
[COLOR=#0000ff]ActiveSheet.[/COLOR]Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).PasteSpecial
Next m
[COLOR=#0000ff]Worksheets("Sheet1").Select[/COLOR]
[COLOR=#0000ff]Application.CutCopyMode = False[/COLOR]
End Sub

Or preferably avoid copy paste and all the associated selections......

Sub Macro2() 'Sub SearchSheetName()
Dim xName As String
On Error GoTo Quit
For m = 2 To 6
xName = Worksheets("Sheet1").Range("A" & m)
With Worksheets(xName)


NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & NextRow & ":C" & NextRow).Value = Sheets("Sheet1").Range("B" & m & ":D" & m).Value
End With
Next m
Quit:
End Sub

Hope that helps but please do not make duplicate posts.

The macro worked
Thanks a lot