delete one of values colums by split data into two sheets

[Alaa mg]

HI

I have about 6700 rows .I want split data sheet by keep one values column for each item for each sheet separately by create the sheets based on headers MONTH1,2 and every time will change and update data in first sheet ,then should update data in divided sheets by clearing data before bring data again with keep the same formatting and borders in divided sheets .

DATA.xlsm
	A	B	C	D
1	ITEM	ID	MONTH1	MONTH2
2	1	MT ASGL-VEN SD-1	12	10
3	2	C-ZER MN/100 TR12	130	0
4	3	BB 2000MN TT GH	90	0
5	4	TRM 2000MN TT GH		16
6	5	BD 234 NH GG	80	90
7	6	BR 111/33M ER HJ	70	90
8	8	VB 145** SS TF HJK	0	45
9	9	DEWR 1222** SS TF HJK	34	30
sheet1

result

DATA.xlsm
	A	B	C
1	ITEM	ID	MONTH1
2	1	MT ASGL-VEN SD-1	12
3	2	C-ZER MN/100 TR12	130
4	3	BB 2000MN TT GH	90
5	4	TRM 2000MN TT GH
6	5	BD 234 NH GG	80
7	6	BR 111/33M ER HJ	70
8	8	VB 145** SS TF HJK	0
9	9	DEWR 1222** SS TF HJK	34
MONTH1

DATA.xlsm
	A	B	C
1	ITEM	ID	MONTH2
2	1	MT ASGL-VEN SD-1	10
3	2	C-ZER MN/100 TR12	0
4	3	BB 2000MN TT GH	0
5	4	TRM 2000MN TT GH	16
6	5	BD 234 NH GG	90
7	6	BR 111/33M ER HJ	90
8	8	VB 145** SS TF HJK	45
9	9	DEWR 1222** SS TF HJK	30
MONTH2

 

[bebo021999]

With your main sheet named "Sheet1"
try below code:

Option Explicit
Sub test()
Dim lc&, rng, cell As Range, item, ws As Worksheet
Worksheets("Sheet1").Activate
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
    rng = Range("C1", Cells(1, lc)).Value
    For Each item In rng
        For Each ws In Sheets
            If ws.Name Like item Then ws.Delete
        Next
        Worksheets("Sheet1").Copy after:=Worksheets(Sheets.Count)
        ActiveSheet.Name = item
    Next
    For Each ws In Sheets
        If ws.Name <> "Sheet1" Then
            For Each cell In ws.Range("C1", ws.Cells(1, lc))
                If Not cell.Value Like ws.Name Then cell.Value = "#N/A"
            Next
            ws.Range("C1", ws.Cells(1, lc)).SpecialCells(xlCellTypeConstants, xlErrors).EntireColumn.Delete
        End If
    Next
End Sub

 

[Alaa mg]

thank .can I keep the values columns in sheet1 without delete it please?

 

[bebo021999]

thank .can I keep the values columns in sheet1 without delete it please?

Have you tested it? Did you find out that sheet 1 was changed?
I beleave with my code, Sheet1 does not change. Only delete columns in sheets "MONTH..."

 

[Alaa mg]

Have you tested it? Did you find out that sheet 1 was changed?

surely I tested . actually it deletes columns C,D values from sheet1

I beleave with my code, Sheet1 does not change. Only delete columns in sheets "MONTH..."

if it's right, I no know what I can say for you , but this is what happens for me . I tested repeatedly and gives the same result

 

[bebo021999]

I am so confuse!
Try to test with this code. Hit F5 to see what is printed in Intermediate Window. Take a screenshot and post it.

Option Explicit
Sub test()
Dim lc&, rng, cell As Range, item, ws As Worksheet
Worksheets("Sheet1").Activate
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
    rng = Range("C1", Cells(1, lc)).Value
    For Each item In rng
        For Each ws In Sheets
            If ws.Name Like item Then ws.Delete
        Next
        Worksheets("Sheet1").Copy after:=Worksheets(Sheets.Count)
        ActiveSheet.Name = item
    Next
    For Each ws In Sheets
     Debug.print ws.Name
        If ws.Name <> "Sheet1" Then      Debug.print ws.Name & "|" & 2
 '           For Each cell In ws.Range("C1", ws.Cells(1, lc))
  '              If Not cell.Value Like ws.Name Then cell.Value = "#N/A"
   '         Next
    '        ws.Range("C1", ws.Cells(1, lc)).SpecialCells(xlCellTypeConstants, xlErrors).EntireColumn.Delete
     '   End If
    Next
End Sub

 

[Alaa mg]

this is what I got
sheet1
sheet1|2
MONTH1
MONTH1|2
MONTH2
MONTH2|2

 

[bebo021999]

So strange! Could you attach file via google drive or dropbox then send link to me (paste here or to my inbox)?

 

[Alaa mg]

here is the file
test.xlsm
notice: I note your code has problem . if I run the code more than one time will gives error because of the sheets names have already existed. as I said in OP

every time will change and update data in first sheet ,then should update data in divided sheets by clearing data before bring data again with keep the same formatting and borders in divided sheets .

this means if I add new data in sheet1 then automatically updated data in devided sheets(no need every time split sheets because of it split from the first time just update data )
thanks

 

[bebo021999]

Its from case sensitive in Sheet1 name.
replace "sheet1" by "Sheet1" then it should works.