create new sheet based on cell value and copy data

[Hasson]

hello

I have sheet MAIN contains data from row 4 . the range is (A4:H) and B2= name customer . so what I want if the B2 is Hasson ,then should create new sheet's name is Hasson and copy data from sheet MAIN into sheet Hasson from row2 and if I return to copy data for sheet has already created , then should copy to the bottom and if the name is new based on B2 then should create new sheet and copy the data from row2 and so on

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[Hasson]

orginal data

OUTPUT.xlsm
	A	B	C	D	E	F	G	H
1		name
2
3
4	ITEM	ID	BRAND	MANFACT	REF	BATCH	ORDER	QTY
5	BS-TA-113	QQW-14 L/R EG	CLA14 SS230	DF/100	RF-100	FT-1	AAR1	12
6	BS-TA-117	QQW-181	RRSDF	BRI	RF-101	FT-2	AAR2	234
7	BS-TA-118	QQW-19	CLA19	ITY CV	RF-102	FT-3	AAR3	400
8	BS-TA-119	QQW-20	KV/1**2	CLA20 CV	RF-103	FT-4	AAR4	123
9	BS-TA-107	QQW-8	CLA8	UKI	RF-104	FT-5	AAR5	456
10	BS-TA-108	QQW-9 N	CLA91	BR	RF-105	FT-6	AAR6	600
main

if the B2 is filled

OUTPUT.xlsm
	A	B	C	D	E	F	G	H
1		name
2		Hasson
3
4	ITEM	ID	BRAND	MANFACT	REF	BATCH	ORDER	QTY
5	BS-TA-113	QQW-14 L/R EG	CLA14 SS230	DF/100	RF-100	FT-1	AAR1	12
6	BS-TA-117	QQW-181	RRSDF	BRI	RF-101	FT-2	AAR2	234
7	BS-TA-118	QQW-19	CLA19	ITY CV	RF-102	FT-3	AAR3	400
8	BS-TA-119	QQW-20	KV/1**2	CLA20 CV	RF-103	FT-4	AAR4	123
9	BS-TA-107	QQW-8	CLA8	UKI	RF-104	FT-5	AAR5	456
10	BS-TA-108	QQW-9 N	CLA91	BR	RF-105	FT-6	AAR6	600
main

and create new sheet

OUTPUT.xlsm
	A	B	C	D	E	F	G	H
3	ITEM	ID	BRAND	MANFACT	REF	BATCH	ORDER	QTY
4	BS-TA-113	QQW-14 L/R EG	CLA14 SS230	DF/100	RF-100	FT-1	AAR1	12
5	BS-TA-117	QQW-181	RRSDF	BRI	RF-101	FT-2	AAR2	234
6	BS-TA-118	QQW-19	CLA19	ITY CV	RF-102	FT-3	AAR3	400
7	BS-TA-119	QQW-20	KV/1**2	CLA20 CV	RF-103	FT-4	AAR4	123
8	BS-TA-107	QQW-8	CLA8	UKI	RF-104	FT-5	AAR5	456
9	BS-TA-108	QQW-9 N	CLA91	BR	RF-105	FT-6	AAR6	600
Hasson

and if run again with the same name then

OUTPUT.xlsm
	A	B	C	D	E	F	G	H
3	ITEM	ID	BRAND	MANFACT	REF	BATCH	ORDER	QTY
4	BS-TA-113	QQW-14 L/R EG	CLA14 SS230	DF/100	RF-100	FT-1	AAR1	12
5	BS-TA-117	QQW-181	RRSDF	BRI	RF-101	FT-2	AAR2	234
6	BS-TA-118	QQW-19	CLA19	ITY CV	RF-102	FT-3	AAR3	400
7	BS-TA-119	QQW-20	KV/1**2	CLA20 CV	RF-103	FT-4	AAR4	123
8	BS-TA-107	QQW-8	CLA8	UKI	RF-104	FT-5	AAR5	456
9	BS-TA-108	QQW-9 N	CLA91	BR	RF-105	FT-6	AAR6	600
10	BS-TA-113	QQW-14 L/R EG	CLA14 SS230	DF/100	RF-100	FT-1	AAR1	12
11	BS-TA-117	QQW-181	RRSDF	BRI	RF-101	FT-2	AAR2	234
12	BS-TA-118	QQW-19	CLA19	ITY CV	RF-102	FT-3	AAR3	400
13	BS-TA-119	QQW-20	KV/1**2	CLA20 CV	RF-103	FT-4	AAR4	123
14	BS-TA-107	QQW-8	CLA8	UKI	RF-104	FT-5	AAR5	456
15	BS-TA-108	QQW-9 N	CLA91	BR	RF-105	FT-6	AAR6	600
Hasson

and if add different name then should create new sheet .

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your "main" sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter a name in B2 and press the RETURN key.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet
    Set srcWS = ActiveSheet
    If Not Evaluate("isref('" & Target.Value & "'!A1)") Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
        With ActiveSheet
            .Range("A1").Resize(, 8).Value = Array("EM", "ID", "BRAND", "MANFACT", "REF", "BATCH", "ORDER", "QTY")
            srcWS.UsedRange.Offset(4).Copy .Range("A2")
            .Columns.AutoFit
        End With
    Else
        With Sheets(Target.Value)
            ActiveSheet.UsedRange.Offset(4).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    End If
    Application.ScreenUpdating = True
End Sub

 

[Hasson]

great code ! just question if you don't mind . I know this is not my requirement in OP how can I mod the code by making replace data instead of copy to the bottom in new sheet,please?

 

[mumps]

making replace data instead of copy to the bottom in new sheet,please

Please explain in detail what you mean by this using examples from your data and post updated sheets if necessary.

 

[Hasson]

see the last picture when run again shouldn't copy to the bottom repeatedly as in rows from 10 :15. it should delete it just copy from the first time

and not copy every time press into cell B2 for the same created new sheet .

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet
    Set srcWS = ActiveSheet
    If Not Evaluate("isref('" & Target.Value & "'!A1)") Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
        With ActiveSheet
            .Range("A1").Resize(, 8).Value = Array("EM", "ID", "BRAND", "MANFACT", "REF", "BATCH", "ORDER", "QTY")
            srcWS.UsedRange.Offset(4).Copy .Range("A2")
            .Columns.AutoFit
        End With
    Else
        With Sheets(Target.Value)
            .UsedRange.Offset(1).ClearContents
            ActiveSheet.UsedRange.Offset(4).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    End If
    Application.ScreenUpdating = True
End Sub

 

[Hasson]

excellent ! but I note when copy the headers it deletes the borders and formatting . it shouldn't. may you fix it ,please?

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet
    Set srcWS = ActiveSheet
    If Not Evaluate("isref('" & Target.Value & "'!A1)") Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target
        With ActiveSheet
            .Range("A1").Resize(, 8).Value = Array("EM", "ID", "BRAND", "MANFACT", "REF", "BATCH", "ORDER", "QTY")
            srcWS.UsedRange.Offset(4).Copy .Range("A2")
            .Columns.AutoFit
            .Range("A1").Resize(, 8).Interior.ColorIndex = 33
            .UsedRange.Cells.Borders.LineStyle = xlContinuous
        End With
    Else
        With Sheets(Target.Value)
            .UsedRange.Offset(1).ClearContents
            ActiveSheet.UsedRange.Offset(4).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    End If
    Application.ScreenUpdating = True
End Sub