Вот используемый для копирования код
- Код: Выделить всё
Function Sheet2NewWorkbook(sFile As String, lShNumber As Long, Optional wbFile As _
EXCEL.Workbook, Optional wb As EXCEL.Workbook, Optional sErr As String) As Boolean
Dim bNewApp As Boolean, bOpenFile As Boolean, bNewBook As Boolean
Dim ws As EXCEL.Worksheet, ws1 As EXCEL.Worksheet
On Error GoTo er
If Not FileExists(sFile) Then Err.Raise clERROR, , "Ôàéë íå íàéäåí"
If AppE Is Nothing Then GetExcel: bNewApp = True
If wbFile Is Nothing Then Set wbFile = AppE.Workbooks.Open(sFile): bOpenFile = True
If wbFile.Sheets.Count < lShNumber Then Err.Raise clERROR, , "Ëèñò " & lShNumber & " íå íàéäåí"
AppE.Visible = True
If wb Is Nothing Then Set wb = AppE.Workbooks.Add(xlWBATWorksheet): bNewBook = True
Set ws = wbFile.Sheets(lShNumber)
Set ws1 = wb.Sheets(wb.Sheets.Count)
ws.Copy After:=ws1 'wb.Sheets(wb.Sheets.Count)
If bNewBook Then
AppE.DisplayAlerts = False
wb.Sheets(1).Delete
AppE.DisplayAlerts = True
End If
If bOpenFile Then wbFile.Close False: Set wbFile = Nothing
Sheet2NewWorkbook = True
GoTo ok
er:
sErr = Err.Description
ok:
If bNewApp Then Set AppE = Nothing
Err.Clear
End Function
Причем, при использовании метода move вместо copy ошибки не выдает. Офис стоит 2003.
[alibek] :: Используй тэг CODE для форматирования программного листинга.