View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.misc
Jacob Skaria Jacob Skaria is offline
external usenet poster
 
Posts: 8,520
Default Copy from One Sheet to Many

If customer is not a none numeric field the below will work...To write a
macro for this you should mention how a customer can be distinguished. Try
the below and feedback

Sub MyMacro()
Dim wsMain As Worksheet
Dim wsNew As Worksheet
Dim lngRow As Long, lngRefRow As Long, lngLastRow As Long
Set wsMain = ActiveSheet
lngLastRow = wsMain.Cells(Rows.Count, "A").End(xlUp).Row + 1
For lngRow = 1 To lngLastRow
If (Trim(wsMain.Range("A" & lngRow)) < "" And _
IsNumeric(wsMain.Range("A" & lngRow)) = False) Or _
lngRow = lngLastRow Then
If lngRefRow Then
Set wsNew = Worksheets.Add(After:=wsMain)
wsNew.Name = wsMain.Range("A" & lngRefRow)
wsMain.Range("A" & lngRefRow & ":A" & lngRow - 1).Copy _
wsNew.Range("A1")
End If
lngRefRow = lngRow
End If
Next
End Sub

If this post helps click Yes
---------------
Jacob Skaria


"osaka78" wrote:

thankx it working fine but if the customer name is Number e.g 11-11 or more
then 32 charchter it is not working

"Jacob Skaria" wrote:

With this sample data try the below macro from the data sheet. The new sheets
will be named aganist the customer name. Hope you dont have already sheets
aganist this name. If so try this macro with a single sheet. Customer name is
identified by a non-numeric first character...Try and feedback

Customer A
1
2
3

Customer B
1
2
3

Sub MyMacro()
Dim wsMain As Worksheet
Dim wsNew As Worksheet
Dim lngRow As Long, lngRefRow As Long, lngLastRow As Long
Set wsMain = ActiveSheet
lngLastRow = wsMain.Cells(Rows.Count, "A").End(xlUp).Row + 1
For lngRow = 1 To lngLastRow
If (Trim(wsMain.Range("A" & lngRow)) < "" And _
IsNumeric(Left(wsMain.Range("A" & lngRow), 1)) = False) Or _
lngRow = lngLastRow Then
If lngRefRow Then
Set wsNew = Worksheets.Add(After:=wsMain)
wsNew.Name = wsMain.Range("A" & lngRefRow)
wsMain.Range("A" & lngRefRow & ":A" & lngRow - 1).Copy _
wsNew.Range("A1")
End If
lngRefRow = lngRow
End If
Next
End Sub

If this post helps click Yes
---------------
Jacob Skaria


"osaka78" wrote:

Thank but i need each customer in a seperate sheet i am looking for Macro ,
bcz i have more then 2000 rows

"Jacob Skaria" wrote:

Not sure whether this is what you are looking for. Suppose you have Sheet1 to
Sheet5; and you want to copy the customers listed in Col A of Sheet1 to all
other sheets.

--Select Sheet1 Column A. (Click on the column header to select) and Right
click 'Copy'
--Select Sheet2 and holding shift key select the last sheet (This will
select sheet2 to sheet5)
--Select cell A1 and Right clickPasteSpecialValuesOK...






If this post helps click Yes
---------------
Jacob Skaria


"osaka78" wrote:

i have the following data in Sheet 1
Customer A
1
2
3

Customer B
1
2
3

i want to copy each customer to different sheet