Добавление на несколько листов в эксель

procedure TOtchet.Button5Click(Sender: TObject);
var
  XL, Sheet: Variant;
  i,s: integer;
 
  N,R: TDateTime;
  Y, M, D, Y2, M2, D2, Y3, M3, D3: Word;
 
begin
  VPR_DM.vpr_main2.Filtered:= False;
  vpr_dm.VPR_main2.Filter := 'vpr_data>='+DateToStr(DateTimePicker3. Date)+' and vpr_data<='+DateToStr(DateTimePicker4.Date);
  vpr_dm.VPR_main2.Filtered:=true;
  if MessageDlg('Действительно добавить данные в Excel?'+#13#10+
  'Подтвердите',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
 Begin
    XL := CreateOleObject('Excel.Application');
    statusbar1.Visible:=true ;
 
   try
    if XL.Workbooks.Count = 0 then begin
     XL.SheetsInNewWorkbook := 1;
     xl.workbooks.open(ExtractFilePath(ParamStr(0))+'для МДЦ (ВПР) по районам Общее за отрывок времени');
   end else
    XL.ActiveWorkbook.WorkSheets.Add;
    s:=0;
    XL.Visible := true;
 
    XL.WorkSheets[1].columns['A:A'].Select;
    XL.WorkSheets[1].Columns['A:A'].Font.Name:='Avant Greek';
    XL.WorkSheets[1].Columns['A:A'].Font.Size:=11;
    XL.WorkSheets[1].Columns['B:B'].Select;
    XL.WorkSheets[1].Columns['B:B'].Font.Name:='BankGothic Lt BT';
    XL.WorkSheets[1].Columns['B:B'].NumberFormat:='0';
 
   try
    i := 5;
    vpr_dm.Vpr_main2.First;
 
    Xl.Range[xl.Cells[i, 3], xl.Cells[vpr_dm.Vpr_main2.RecordCount+4, vpr_dm.Vpr_main2.Fields.Count]].select;
    XL.Selection.Borders.LineStyle := 7;
    xl.Selection.Borders.Weight := 2;
    XL.Range[XL.Cells[i, 3], XL.Cells[i, 3]].Select;
 
   while not vpr_dm.Vpr_main2.EOF do begin
      Sheet := xl.WorkSheets[s+1];
      Sheet.Name := 'Общий за определенный период';
 
      n:=now;
      Decodedate(n, y, m, d);
      r:=vpr_dm.Vpr_main2.FieldByName('data_r').AsDateTime;
      Decodedate(r, y2, m2, d2);
 
Sheet.Cells[1, 3].value := 'Списочный состав пациентов за:' ;
Sheet.Cells[2, 3].value := 'С '+DateToStr(DateTimePicker3. Date)+' по '+DateToStr(DateTimePicker4.Date);
Sheet.Cells[i, 3].Value := vpr_dm.spr_lpu2.FieldByName('Name').AsString;//vpr_dm.Vpr_main2.FieldByName('kod_lpu').AsString;
Sheet.Cells[i, 4].Value := vpr_dm.Vpr_main2.FieldByName('fam').AsString;
Sheet.Cells[i, 5].Value := vpr_dm.Vpr_main2.FieldByName('im').AsString;
Sheet.Cells[i, 6].Value := vpr_dm.Vpr_main2.FieldByName('ot').AsString;
Sheet.Cells[i, 7].Value := vpr_dm.spr_pol2.FieldByName('Name').AsString;
Sheet.Cells[i, 8].Value := vpr_dm.Vpr_main2.FieldByName('data_r').AsString;
Sheet.Cells[i, 9].Value := vpr_dm.Vpr_main2.FieldByName('vpr_data').AsString;
Sheet.Cells[i, 10].Value := vpr_dm.Vpr_main2.FieldByName('vpr_ds_1').AsString;
Sheet.Cells[i, 11].Value := vpr_dm.Vpr_main2.FieldByName('vpr_ds_2').AsString;
Sheet.Cells[i, 12].Value := vpr_dm.Vpr_main2.FieldByName('vpr_ds_3').AsString;
Sheet.Cells[i, 13].Value := vpr_dm.Vpr_main2.FieldByName('vpr_ds_4').AsString;
if  (y-y2)+1 > 1 then  Sheet.Cells[i, 14].Value :='Больше 1 года' else Sheet.Cells[i, 14].Value :='Меньше 1 года';
Sheet.Cells[i, 15].Value := vpr_dm.Vpr_main2.FieldByName('adrd').AsString;
Sheet.Cells[i, 16].Value := vpr_dm.Vpr_main2.FieldByName('adrd_dom').AsString;
Sheet.Cells[i, 17].Value := vpr_dm.Vpr_main2.FieldByName('adrd_korp').AsString;
Sheet.Cells[i, 18].Value := vpr_dm.Vpr_main2.FieldByName('adrd_kv').AsString;
 
    i := i + 1;
 
    vpr_dm.Vpr_main2.Next;
  end;
  finally
   XL.WorkSheets[1].Columns['A:A'].Select;
   XL.WorkSheets[1].Columns['A:A'].Rows.AutoFit;
   XL.WorkSheets[1].Columns['A:A'].Columns.AutoFit;
   XL.WorkSheets[1].Columns['B:B'].Select;
   XL.WorkSheets[1].Columns['B:B'].Rows.AutoFit;
   XL.WorkSheets[1].Columns['B:B'].Columns.AutoFit;
 
  end;
    finally
    statusbar1.Visible:=false ;
    end;
  End;
    end;