Macro to Keep Sheet Names as Sheet1 and Sheet2

djmnon

New Member
Joined
Mar 22, 2022
Messages
19
Office Version
  1. 365
  2. 2021
  3. 2019
  4. 2016
  5. 2013
  6. 2010
  7. 2007
Platform
  1. Windows
I have a macro which I have created which basically filters out the data and copy pastes it into 2 different sheets (this is standard).

So whenever I run the Macro say 1st time it will show as Sheet1 and Sheet2
Whenever I run the Macro say 2nd time it shows as Sheet3 and Sheet4

Expected Result.

Everytime I run the Macro it the sheet names should be as Sheet1 and Sheet2

How do I do this?

Below is the Macro :- this is a Recorded Macro want to modify it by renaming the file names to Sheet1 and Sheet2 everytime

Sub dave()
'
' dave Macro
'

'
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$U$9995").AutoFilter Field:=8, Criteria1:= _
"Home Office"
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
Sheets("Orders").Select
ActiveWindow.ScrollRow = 9851
ActiveWindow.ScrollRow = 9761
ActiveWindow.ScrollRow = 9656
ActiveWindow.ScrollRow = 9536
ActiveWindow.ScrollRow = 9372
ActiveWindow.ScrollRow = 8698
ActiveWindow.ScrollRow = 8473
ActiveWindow.ScrollRow = 7785
ActiveWindow.ScrollRow = 5704
ActiveWindow.ScrollRow = 5030
ActiveWindow.ScrollRow = 4851
ActiveWindow.ScrollRow = 4312
ActiveWindow.ScrollRow = 4012
ActiveWindow.ScrollRow = 3578
ActiveWindow.ScrollRow = 3444
ActiveWindow.ScrollRow = 3234
ActiveWindow.ScrollRow = 3144
ActiveWindow.ScrollRow = 2935
ActiveWindow.ScrollRow = 2830
ActiveWindow.ScrollRow = 2560
ActiveWindow.ScrollRow = 1707
ActiveWindow.ScrollRow = 1497
ActiveWindow.ScrollRow = 1378
ActiveWindow.ScrollRow = 1273
ActiveWindow.ScrollRow = 1213
ActiveWindow.ScrollRow = 1138
ActiveWindow.ScrollRow = 1093
ActiveWindow.ScrollRow = 1063
ActiveWindow.ScrollRow = 1048
ActiveWindow.ScrollRow = 1018
ActiveWindow.ScrollRow = 1003
ActiveWindow.ScrollRow = 989
ActiveWindow.ScrollRow = 974
ActiveWindow.ScrollRow = 959
ActiveWindow.ScrollRow = 914
ActiveWindow.ScrollRow = 884
ActiveWindow.ScrollRow = 809
ActiveWindow.ScrollRow = 779
ActiveWindow.ScrollRow = 704
ActiveWindow.ScrollRow = 644
ActiveWindow.ScrollRow = 569
ActiveWindow.ScrollRow = 524
ActiveWindow.ScrollRow = 495
ActiveWindow.ScrollRow = 465
ActiveWindow.ScrollRow = 450
ActiveWindow.ScrollRow = 420
ActiveWindow.ScrollRow = 390
ActiveWindow.ScrollRow = 345
ActiveWindow.ScrollRow = 315
ActiveWindow.ScrollRow = 285
ActiveWindow.ScrollRow = 240
ActiveWindow.ScrollRow = 210
ActiveWindow.ScrollRow = 180
ActiveWindow.ScrollRow = 135
ActiveWindow.ScrollRow = 105
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 60
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 1
ActiveSheet.Range("$A$1:$U$9995").AutoFilter Field:=13, Criteria1:="East"
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A98").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
Sheets("Orders").Select
End Sub
 
Orders Main Data
Macro Runs and creates Sheet1 and Sheet2
Sheet1 data along with Headers Copy to Sheet3 and Sheet2 data copy and append below the last row of Sheet1 data (append)

I hope the above one works that way. Apologies if I confused you.
 
Upvote 0

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
perhaps there are better ways, check if sheet1...3 exists and if so clear them instead of deleting and recreating ...
VBA Code:
Sub dave()

     On Error Resume Next                                       'proceed in case of error (if sheets doesn't excist)
     Application.DisplayAlerts = False                          'give no alert
     Sheets("sheet1").Delete                                    'delete those sheets
     Sheets("sheet2").Delete
     Sheets("sheet3").Delete
     Application.DisplayAlerts = True
     On Error GoTo 0

     With Sheets("Orders")                                      '<---------give here the name of the sheet, i think it's Orders
          .Range("A1").AutoFilter
          With .Range("$A$1:$U$9995")
               .AutoFilter Field:=8, Criteria1:="Home Office"   '1st filter
               .SpecialCells(xlVisible).Copy                    'the visible cells only

               Sheets.Add After:=ActiveSheet                    'copy a first time to sheet1
               With ActiveSheet
                    .Paste
                    .Name = "SHEET1"
               End With

               Sheets.Add After:=ActiveSheet                    'copy a 2nd time to sheet3
               With ActiveSheet
                    .Paste
                    .Name = "SHEET3"
               End With

               .AutoFilter Field:=13, Criteria1:="East"         '2nd filter
               .SpecialCells(xlVisible).Copy

               Sheets.Add After:=ActiveSheet                    'copy a 1st time to sheet2
               With ActiveSheet
                    .Paste
                    .Name = "SHEET2"
               End With

               .Offset(1).SpecialCells(xlVisible).Copy          'copy a 2nd time and append in sheet3
               With Sheets("sheet3")                            'to a 3rd sheet
                    With .Range("A" & Rows.Count).End(xlUp).Offset(1)     'next free A-cell
                         .Paste
                    End With
               End With

          End With
     End With

End Sub
 
Upvote 0
Modified the code a bit but its giving me the error when I run the code (highlighted in Black below). When I remove the paste operation its working but not sure if the append is working correctly when I check Sheet1 it shows 33 Count. Sheet2 is showing 32 count and the Sheet 3 which should append Sheet1 and Sheet2 should show 65 basically appending...its showing 98 records.



Rich (BB code):
Sub dave()

     On Error Resume Next                                       'proceed in case of error (if sheets doesn't excist)
     Application.DisplayAlerts = False                          'give no alert
     Sheets("sheet1").Delete                                    'delete those sheets
     Sheets("sheet2").Delete
     Sheets("sheet3").Delete
     Application.DisplayAlerts = True
     On Error GoTo 0

     With Sheets("Orders")                                      '<---------give here the name of the sheet, i think it's Orders
          .Range("A1").AutoFilter
          With .Range("$A$1:$U$9995")
               .AutoFilter
               .AutoFilter Field:=8, Criteria1:="Home Office"   '1st filter
               .AutoFilter Field:=5, Criteria1:="First Class"   '2nd filter
               .AutoFilter Field:=13, Criteria1:="South"        '3rd filter
               .SpecialCells(xlVisible).Copy                    'the visible cells only

               Sheets.Add After:=ActiveSheet                    'copy a first time to sheet1
               With ActiveSheet
                    .Paste
                    .Name = "Sheet1"
               End With

               Sheets.Add After:=ActiveSheet                    'copy a 2nd time to sheet2
               With ActiveSheet
                    .Paste
                    .Name = "Sheet2"
               End With

               .AutoFilter Field:=13, Criteria1:="East"         '2nd filter
               .AutoFilter Field:=5, Criteria1:="First Class"   '2nd filter
               .AutoFilter Field:=8, Criteria1:="Home Office"   '3rd filter
               .SpecialCells(xlVisible).Copy

               Sheets.Add After:=ActiveSheet                    'copy a 1st time to sheet2
               With ActiveSheet
                    .Paste
                    .Name = "Sheet3"
               End With

               .Offset(1).SpecialCells(xlVisible).Copy          'copy a 2nd time and append in sheet3
               With Sheets("Sheet3")                            'to a 3rd sheet
                    With .Range("A" & Rows.Count).End(xlUp).Offset(1)     'next free A-cell
                    .Paste
                    End With
               End With

          End With
     End With

End Sub
 

Attachments

  • dfsdfsd.png
    dfsdfsd.png
    85.4 KB · Views: 9
Last edited by a moderator:
Upvote 0
The 1st filtered rows, you copy them to new created sheets sheet1 and sheet2 (minus the header).
So 33 and 32 seems okay.
then the 2nd filtered rows, you copy them twice to sheet3, once normal, once without the header.
And those 98 ?? That number should be uneven.
But the problem is your logic here, isn't it ?
 
Upvote 0
The 1st filtered rows, you copy them to new created sheets sheet1 and sheet2 (minus the header).
So 33 and 32 seems okay.
then the 2nd filtered rows, you copy them twice to sheet3, once normal, once without the header.
And those 98 ?? That number should be uneven.
But the problem is your logic here, isn't it ?

I think so I'm going wrong somewhere....its becoming hard to go to and for from this platform and making changes..
 
Last edited by a moderator:
Upvote 0

Forum statistics

Threads
1,215,064
Messages
6,122,941
Members
449,094
Latest member
teemeren

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top