Export Access 97 to Excel on multiple worksheets extra sheets produced

Please can anyone help me I have an access database
which outputs data to Excel on several unknown worksheets
and names each worksheet acording to its contract.

Each week I have to produce 20 Payment Certificates for all the contractors.
I have a form in access where the contractor and week ending parameters can be
selected to run the code below which is attached to a button.

Depending on the work each contractor does each week I do not know what ContractName will be produced each week for a contractor.

To fix this I have a query that provides Recordset Rst_2 with the exact contract names for the data retreived on each contractor. Rst_2 provides the names for each of the worksheets as the recordset is looped.

The code first looks for the parameter specified in my form when I select the contractor
I have defined 20 if statements to set the location folder to save the Certificate.


The code then opens the windows open save dialog at the correct folder directory.

On the form I have a Picture field with a logo the code sets focus on this field and
copies to memory

When the data is exported to exel from recordset Rst_1 the field is pasted onto cell (1,7)

My code is working very well but the problem I am having is that the code is also creating
extra worksheets that do not have any data or worksheet name after my named worksheets i.e. sheet2,sheet3 etc.

This is the part that creates the sheets with a format of 97% zoom in landscape.

Do Until Rst_2.EOF
FldName = Rst_2.Fields("ContractName")
Set shts = wkbk.ActiveSheet
wkbk.Sheets.add
shts.PageSetup.Orientation = xlLandscape
shts.PageSetup.Zoom = 97

********************
This part sorts and moves the worksheets in order

With wkbk
FirstSheet = .Sheets(1).Name
SheetCount = .Worksheets.Count
.Sheets(FirstSheet).Move After:=.Sheets(SheetCount)
.Sheets(1).Select


Would anyone know how to reduce or delete the extra unknown sheets.

Here is my code attached.

Thank you.