Cut and Paste Macro into another sheet

[Prashant2082]

Hi Everyone,

I am trying to create a macro to identify certain record in one sheet, and cut and paste that record in another sheet.

eg:
Sheet names - Names, John, James, Charlie
Sheet Names: Column A - Sample values - John, James, Charlie

as per my requirement, if i run the macro, it should find the different names in Column A of sheet "Name" and should insert the record in respective sheet.

Could you please advice.

Thanks and Regards,
Prashant

 

[VoG]

Try Excel Explosion http://www.datapigtechnologies.com/freeware.htm

This will create the extra sheets - don't add them yourself.

 

[Prashant2082]

Hi Peter,

Thanks for your time and response.
However, just wanted to highlight, i need to append the data on ongoing basis on existing sheets. So i can not use new sheets.

Please advice.

Thanks and Regards,
Prashant

 

[VoG]

Perhaps this

Sub ToNames()
Dim LR As Long, i As Long
With Sheets("Name")
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        .Rows(i).Copy Destination:=Sheets(.Range("A" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next i
End With
End Sub

 

[Prashant2082]

Thanks Peter.

But now i am getting error subscript out of range.
I tried to see excel help, but it doesnot look like similar scenario given.

I am relatively new in macro. Could you please advice.

Regards,
Prashant

 

[VoG]

When that error occurs click the Debug button. Which line of code is highlighted?

 

[Prashant2082]

Hi Peter,

Its coming on
.Rows(i).Copy Destination:=Sheets(.Range("A" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1)

Regards,
Prashant

 

[VoG]

That means that a sheet with one of your names doesn't exist. Try

Sub ToNames()
Dim LR As Long, i As Long
With Sheets("Name")
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        If Not WorksheetExists(.Range("A" & i).Value) Then Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = .Range("A" & i).Value
        .Rows(i).Copy Destination:=Sheets(.Range("A" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next i
End With
End Sub


Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function

 

[Prashant2082]

Hi Peter,

Its working now.
Thanks for all your help.

Regards,
Prashant