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
[TABLE="width: 256"]
<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]Sheet1[/TD]
[TD="width: 64"]Option [/TD]
[TD="width: 64"]Strike[/TD]
[TD="width: 64"]Expiry[/TD]
[/TR]
[TR]
[TD]NIkit[/TD]
[TD]c[/TD]
[TD="align: right"]11200[/TD]
[TD="class: xl63, align: right"]27-Jun-19[/TD]
[/TR]
[TR]
[TD]sandeep[/TD]
[TD]P[/TD]
[TD="align: right"]11300[/TD]
[TD="class: xl63, align: right"]27-Jun-19[/TD]
[/TR]
[TR]
[TD]Shraddha[/TD]
[TD]c[/TD]
[TD="align: right"]11400[/TD]
[TD="class: xl63, align: right"]27-Jun-19[/TD]
[/TR]
[TR]
[TD]NAyan[/TD]
[TD]C[/TD]
[TD="align: right"]11500[/TD]
[TD="class: xl63, align: right"]27-Jun-19[/TD]
[/TR]
[TR]
[TD]sansbin[/TD]
[TD]P[/TD]
[TD="align: right"]11600[/TD]
[TD="class: xl63, align: right"]27-Jun-19[/TD]
[/TR]
</tbody>[/TABLE]

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