clear contents cells for specific sheets except last sheet when save new file

[leap out]

Hi
I want to export file as xlsm with keep the same sheets names and formatting , but should replace data form summary sheet with stock sheet and clear sheets (sales,pur,RETURNS,SUMMARY) with keep the same formatting and when save the file should be file name STOCK-& current year . and should replace data every time run the macro based on current year.

original data

INVEN with single search v0 c.xlsm
	A	B	C	D	E	F
1	item	CODE	BRAND	TYPE	MANUFACTURE	QTY
2	1	AA-1	10W40 208L	Q8	EU	2222
3	2	AA-2	15W40 208L	CAS	SU	400
4	3	AA-3	5W30 208L	Q8	EU	800
5	4	AA-4	5W30 12x1L	Q8	EU	600
6	5	AA-5	10W40 208L	ENI	IT	300
7	6	AA-6	5W30 4x4L	Q8	EU	200
8	7	AA-7	10W40 12x1L	Q8	EU	120
9	8	AA-8	15W40 12x1L	CAS	SU	450
10	9	AA-9	10W40 12x1L	ENI	IT	890
11	10	AA-10	10W40 4x4L	Q8	EU	345
12	11	AA-11	10W40 4x4L	CAS	SU	78
13	12	AA-12	10W40 4x4L	ENI	IT	123
14	13	AA-13	5W40 4x4L	Q8	EU	456
15	14	AA-14	5W40 4x4L	CAS	SU	678
16	15	AA-15	5W40 4x4L	ENI	IT	1234
17	16	AA-16	20W50 4x4L	Q8	EU	456
STOCK

INVEN with single search v0 c.xlsm
	A	B	C	D	E	F
1	DATE	CODE	BRAND	TYPE	MANUFACTURE	SALES
2	01/01/2021	AA-1	10W40 208L	Q8	EU	100
3	02/01/2021	AA-2	15W40 208L	CAS	SU	50
4	03/01/2021	AA-3	5W30 208L	Q8	EU	280
5	04/01/2021	AA-4	5W30 12x1L	Q8	EU	300
6	05/01/2021	AA-5	10W40 208L	ENI	IT	80
7	06/01/2021	AA-6	5W30 4x4L	Q8	EU	20
8	07/01/2021	AA-7	10W40 12x1L	Q8	EU	20
9	08/01/2021	AA-8	15W40 12x1L	CAS	SU	20
10	09/01/2021	AA-9	10W40 12x1L	ENI	IT	876
11	10/01/2021	AA-10	10W40 4x4L	Q8	EU	345
12	11/01/2021	AA-11	10W40 4x4L	CAS	SU	123
13	12/01/2021	AA-12	10W40 4x4L	ENI	IT	78
14	13/01/2021	AA-13	5W40 4x4L	Q8	EU	300
15	14/01/2021	AA-14	5W40 4x4L	CAS	SU	34
16	15/01/2021	AA-15	5W40 4x4L	ENI	IT	23
17	16/01/2021	AA-16	20W50 4x4L	Q8	EU	56
18	17/01/2021	AA-1	10W40 208L	Q8	EU	100
sales

INVEN with single search v0 c.xlsm
	A	B	C	D	E	F
1	DATE	CODE	BRAND	TYPE	MANUFACTURE	PURCHASE
2	04/02/2021	AA-1	10W40 208L	Q8	EU	55
3	05/02/2021	AA-2	15W40 208L	CAS	SU	20
4	06/02/2021	AA-3	5W30 208L	Q8	EU	10
5	07/02/2021	AA-4	5W30 12x1L	Q8	EU	10
6	08/02/2021	AA-5	10W40 208L	ENI	IT	3
7	09/02/2021	AA-6	5W30 4x4L	Q8	EU	4
8	10/02/2021	AA-7	10W40 12x1L	Q8	EU	45
9	11/02/2021	AA-8	15W40 12x1L	CAS	SU	8
10	12/02/2021	AA-9	10W40 12x1L	ENI	IT	1
11	13/02/2021	AA-10	10W40 4x4L	Q8	EU	100
12	14/02/2021	AA-11	10W40 4x4L	CAS	SU	20
13	15/02/2021	AA-12	10W40 4x4L	ENI	IT	100
14	16/02/2021	AA-13	5W40 4x4L	Q8	EU	44
15	17/02/2021	AA-14	5W40 4x4L	CAS	SU	20
16	18/02/2021	AA-15	5W40 4x4L	ENI	IT	50
17	19/02/2021	AA-16	20W50 4x4L	Q8	EU	12
18	20/02/2021	AA-17	20W50 4x4L	CAS	SU	9
19	21/02/2021	AA-18	20W50 4x4L	ENI	IT	4
20	22/02/2021	AA-1	10W40 208L	Q8	EU	55
pur

INVEN with single search v0 c.xlsm
	A	B	C	D	E	F
1	item	CODE	BRAND	TYPE	MANUFACTURE	returns
2	05/04/2021	AA-9	10W40 12x1L	ENI	IT	20
3	06/04/2021	AA-10	10W40 4x4L	Q8	EU	30
4	07/04/2021	AA-11	10W40 4x4L	CAS	SU	40
5	08/04/2021	AA-4	5W30 12x1L	Q8	EU	10
6	09/04/2021	AA-4	5W30 12x1L	Q8	EU	11
RETURNS

INVEN with single search v0 c.xlsm
	A	B	C	D	E	F	G	H	I	J
1	item	CODE	BRAND	TYPE	MANUFACTURE	STOCK	SALES	PUR	RETURNS	BALANCE
2	1	AA-1	10W40 208L	Q8	EU	2222	200	110		2132
3	2	AA-2	15W40 208L	CAS	SU	400	50	20		370
4	3	AA-3	5W30 208L	Q8	EU	800	280	10		530
5	4	AA-4	5W30 12x1L	Q8	EU	600	300	10	21	331
6	5	AA-5	10W40 208L	ENI	IT	300	80	3		223
7	6	AA-6	5W30 4x4L	Q8	EU	200	20	4		184
8	7	AA-7	10W40 12x1L	Q8	EU	120	20	45		145
9	8	AA-8	15W40 12x1L	CAS	SU	450	20	8		438
10	9	AA-9	10W40 12x1L	ENI	IT	890	876	1	20	35
11	10	AA-10	10W40 4x4L	Q8	EU	345	345	100	30	130
12	11	AA-11	10W40 4x4L	CAS	SU	78	123	20	40	15
13	12	AA-12	10W40 4x4L	ENI	IT	123	78	100		145
14	13	AA-13	5W40 4x4L	Q8	EU	456	300	44		200
15	14	AA-14	5W40 4x4L	CAS	SU	678	34	20		664
16	15	AA-15	5W40 4x4L	ENI	IT	1234	23	50		1261
17	16	AA-16	20W50 4x4L	Q8	EU	456	56	12		412
18	17	AA-17	20W50 4x4L	CAS	SU			9		9
19	18	AA-18	20W50 4x4L	ENI	IT			4		4
SUMMARY

result should save file as xlsm

STOCK-2023.xlsm
	A	B	C	D	E	F	G	H	I	J
1	item	CODE	BRAND	TYPE	MANUFACTURE	STOCK	SALES	PUR	RETURNS	BALANCE
2	1	AA-1	10W40 208L	Q8	EU	2222	200	110		2132
3	2	AA-2	15W40 208L	CAS	SU	400	50	20		370
4	3	AA-3	5W30 208L	Q8	EU	800	280	10		530
5	4	AA-4	5W30 12x1L	Q8	EU	600	300	10	21	331
6	5	AA-5	10W40 208L	ENI	IT	300	80	3		223
7	6	AA-6	5W30 4x4L	Q8	EU	200	20	4		184
8	7	AA-7	10W40 12x1L	Q8	EU	120	20	45		145
9	8	AA-8	15W40 12x1L	CAS	SU	450	20	8		438
10	9	AA-9	10W40 12x1L	ENI	IT	890	876	1	20	35
11	10	AA-10	10W40 4x4L	Q8	EU	345	345	100	30	130
12	11	AA-11	10W40 4x4L	CAS	SU	78	123	20	40	15
13	12	AA-12	10W40 4x4L	ENI	IT	123	78	100		145
14	13	AA-13	5W40 4x4L	Q8	EU	456	300	44		200
15	14	AA-14	5W40 4x4L	CAS	SU	678	34	20		664
16	15	AA-15	5W40 4x4L	ENI	IT	1234	23	50		1261
17	16	AA-16	20W50 4x4L	Q8	EU	456	56	12		412
18	17	AA-17	20W50 4x4L	CAS	SU			9		9
19	18	AA-18	20W50 4x4L	ENI	IT			4		4
STOCK

STOCK-2023.xlsm
	A	B	C	D	E	F
1	DATE	CODE	BRAND	TYPE	MANUFACTURE	SALES
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
sales

STOCK-2023.xlsm
	A	B	C	D	E	F
1	DATE	CODE	BRAND	TYPE	MANUFACTURE	PURCHASE
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
pur

STOCK-2023.xlsm
	A	B	C	D	E	F
1	item	CODE	BRAND	TYPE	MANUFACTURE	returns
2
3
4
5
6
RETURNS

STOCK-2023.xlsm
	A	B	C	D	E	F	G	H	I	J
1	item	CODE	BRAND	TYPE	MANUFACTURE	STOCK	SALES	PUR	RETURNS	BALANCE
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
SUMMARY

I hope this make sense
thanks

 

[OaklandJim]

I believe that I have code for you that does what you asked for.

Note that I used something called "code names" for the worksheets so that if someone changes the name for a worksheet in the worksheet's tab the code will still work.

A decent characterization of code names for worksheets is HERE.

The workbook is HERE.

Here is the code

Sub UpdateStock()

    Dim rRangeToClear As Range
    
    Dim iDataColumns As Long
    
    Dim iDataRows As Long
    
    [Stock].Range("A1").CurrentRegion.Clear '<=uses code name for Stock worksheet.
    
    With [Sales] '<= code name for Sales worksheet
        
'       Count of rows to clear.
        iDataRows = .Range("A1").Offset(100000).End(xlUp).Row - 1

'       Count of columns to clear.
        iDataColumns = .Range("A1").Offset(0, 1000).End(xlToLeft).Column
        
'       Range whose data is cleared. Does not include headers.
        Set rRangeToClear = .Range("A1").Offset(1).Resize(iDataRows, iDataColumns)
        
        With rRangeToClear
            .Interior.Color = xlNone  'clear interior colors
            .Value = "" 'clear the data colors
        End With
    
    End With

    With [Pur] '<= code name for Pur worksheet
        
        iDataRows = .Range("A1").Offset(100000).End(xlUp).Row - 1
        
        iDataColumns = .Range("A1").Offset(0, 1000).End(xlToLeft).Column
        
        Set rRangeToClear = .Range("A1").Offset(1).Resize(iDataRows, iDataColumns)
        
        With rRangeToClear
            .Interior.Color = xlNone
            .Value = ""
        End With
    
    End With

    With [Returns] '<= uses code name for Returns worksheet
        
        iDataRows = .Range("A1").Offset(100000).End(xlUp).Row - 1
        
        iDataColumns = .Range("A1").Offset(0, 1000).End(xlToLeft).Column
        
        Set rRangeToClear = .Range("A1").Offset(1).Resize(iDataRows, iDataColumns)
        
        With rRangeToClear
            .Interior.Color = xlNone
            .Value = ""
        End With
    
    End With

    With [Summary] '<= uses code name for Summary worksheet
            
'       Copy Summary worksheet contents to Stock worksheet.
'       Includes headers.
        .Range("A1").CurrentRegion.Copy [Stock].Range("A1")
        
        iDataRows = .Range("A1").Offset(100000).End(xlUp).Row - 1
        
        iDataColumns = .Range("A1").Offset(0, 1000).End(xlToLeft).Column
            
        Set rRangeToClear = .Range("A1").Offset(1).Resize(iDataRows, iDataColumns)
        
        rRangeToClear.Value = ""
        
    End With

End Sub

 

[leap out]

first thanks for the code & file
second I'm so confused when I put your code in my real file it gives error object required in this line

[Stock].Range("A1").CurrentRegion.Clear '<=uses code name for Stock worksheet.

despite of I made sure from sheets names
third as I said

I want to export file as xlsm with keep the same sheets names and formatting

should keep original data for source workbook and add new file when clear data with rename the file as I said

when save the file should be file name STOCK-& current year

 

[OaklandJim]

Please see the link about worksheet code names that I provided. I use "code names" not "sheet/tab names". That is the issue. With code names if someone changes the sheet/tab names the code still works.

 

[leap out]

this is what I have in my real file

 

[OaklandJim]

Sorry, my misunderstanding. So code should save the existing workbook as-is and only create and save another workbook with the new data in it and the other sheets cleared?

Because I cannot test your workbook I am not sure how to address the issue with my code. Can you take out sensitive data and provide a link to the workbook? I'll try to fix the problem.

 

[leap out]

ok here is the file and take your time
INVEN with single search v0 c (1).xlsm

 

[OaklandJim]

I hope that this does what is needed. The new file is HERE.

 

[leap out]

fantastic !
can you modify a little things in stock sheet after copy data from SUMMARY sheet, please?
I want deleting columns STOCK,SALES,PUR,RETURNS , also change header BALANCE to QTY
thanks for your assistance .

 

[OaklandJim]

This code does what you want. Note use of absolute cell/range references that will have to be changed if the structure of the worksheet changes.

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: UpdateStock
' Purpose: Udate workbook then saveas, file name = Stock-Year
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 4/20/2023
' ----------------------------------------------------------------

Sub UpdateStock()

    Dim rRangeToClear As Range
    
    Dim iDataColumns As Long
    
    Dim iDataRows As Long
    
    Dim sPathToFile As String
    
    Dim sFileToSaveName As String
    
    Dim sMsg As String
    
    Dim vAns As Variant
    
    Application.ScreenUpdating = False
    
    sPathToFile = ThisWorkbook.Path & "\"
    
    sFileToSaveName = "Stock-" & Year(Now) & ".xlsm"
    
'   If the file already exists tell user and ask whether
'   to overwrite the existing file with the new one.
    If Dir(sPathToFile & sFileToSaveName) <> "" _
     Then
        sMsg = "The file named " & sFileToSaveName & " already" _
        & Chr(10) _
        & "exists in " & sPathToFile & "." & Chr(10) & "Replace?"
        
        vAns = MsgBox(sMsg, vbYesNo, "Saving the file.")
        
        If vAns = vbNo Then Exit Sub
        
'       Delete the file before saving it (again)
        Kill (sPathToFile & sFileToSaveName)
        
    End If
    
    [Stock].Range("A1").CurrentRegion.Clear '<=uses code name for Stock worksheet.
    
    With [sales] '<= code name for Sales worksheet
        
'       Count of rows to clear.
        iDataRows = .Range("A1").Offset(100000).End(xlUp).Row - 1

'       Count of columns to clear.
        iDataColumns = .Range("A1").Offset(0, 1000).End(xlToLeft).Column
        
'       Range whose data is cleared. Does not include headers.
        Set rRangeToClear = .Range("A1").Offset(1).Resize(iDataRows, iDataColumns)
        
        With rRangeToClear
            .Interior.Color = xlNone  'clear interior colors
            .Value = "" 'clear the data colors
        End With
    
    End With

    With [pur] '<= code name for Pur worksheet
        
        iDataRows = .Range("A1").Offset(100000).End(xlUp).Row - 1
        
        iDataColumns = .Range("A1").Offset(0, 1000).End(xlToLeft).Column
        
        Set rRangeToClear = .Range("A1").Offset(1).Resize(iDataRows, iDataColumns)
        
        With rRangeToClear
            .Interior.Color = xlNone
            .Value = ""
        End With
    
    End With

    With [RETURNS] '<= uses code name for Returns worksheet
        
        iDataRows = .Range("A1").Offset(100000).End(xlUp).Row - 1
        
        iDataColumns = .Range("A1").Offset(0, 1000).End(xlToLeft).Column
        
        Set rRangeToClear = .Range("A1").Offset(1).Resize(iDataRows, iDataColumns)
        
        With rRangeToClear
            .Interior.Color = xlNone
            .Value = ""
        End With
    
    End With

    With [SUMMARY] '<= uses code name for Summary worksheet
    
        .Activate
            
'       Copy Summary worksheet contents to Stock worksheet.
'       Includes headers.
        .Range("A1").CurrentRegion.Copy [Stock].Range("A1")
        
        .Range("A1").Select
        
        iDataRows = .Range("A1").Offset(100000).End(xlUp).Row - 1
        
        iDataColumns = .Range("A1").Offset(0, 1000).End(xlToLeft).Column
            
        Set rRangeToClear = .Range("A1").Offset(1).Resize(iDataRows, iDataColumns)
        
        rRangeToClear.Value = ""
        
    End With
        
    With [Stock]
    
        .Activate
        .Columns("F:I").Delete Shift:=xlToLeft  '<= may need change if worksheet structure changes.
        .Range("F1").Value = "QTY"              '<= may need change if worksheet structure changes.
        .Range("A1").Activate                   '<= may need change if worksheet structure changes.
    
    End With
    
    ThisWorkbook.SaveAs sPathToFile & sFileToSaveName

End Sub

 

[leap out]

Great !
thanks very much for your time & assistance .