VB excel 工作表未复制到新工作簿

VB excel worksheet not copying to new workbook

难以将工作表从源簿复制到目标簿。 我已经尝试了在 SO 上找到的 4 种不同的代码,但是 运行 一直出现不同的错误。 或者:“复制方法失败”、“未找到此类接口”、“异常”- 在复制功能处。

我知道有很多链接和网站提到了复制方法,但我都试过了,还是不行。

选项严格 = 关闭 选项显式 = 开

Excel 2016 对比 2019

Sourceworkbook 在单元格和合并单元格中有格式设置。需要复制方法中包含的格式,因为我将使用新工作簿作为备份或打印副本。 sourceworkbook 在其中一张名为“TempPage”的工作表上有一个模板。

代码:

    xlApp1 = New Excel.Application
    xlWorkBook1 = xlApp1.Workbooks.Add
    'xlWorkSheet1 = CType(xlWorkBook1.Sheets.Add(), Excel.Worksheet)



    xlWorkSheet = CType(xlWorkBook.Sheets("TempPage"), Excel.Worksheet) 'Source
    xlWorkSheet1 = CType(xlWorkBook1.Sheets("Sheet1"), Excel.Worksheet) 'Destination

    'Tried this code
    'Dim rngSource As Excel.Range, rngTarget As Excel.Range, targetRow As Long
    'rngSource = xlWorkBook.Sheets("TempPage").UsedRange
    'With xlWorkBook.Sheets("TempPage")
    'targetRow = .UsedRange.SpecialCells(XlCellType.xlCellTypeLastCell).Row + 1
    'rngTarget = .cells(targetRow, rngSource.Column)
    'End With
    'rngSource.Copy(rngTarget)


    'Tried this code
    'Dim sourceWorkSheet As Excel.Worksheet
    'sourceWorkSheet = xlWorkBook.Sheets("TempPage")
    '//Copies the source worksheet to the destination workbook, places it after the last
    '//sheet in the destination workbook.
    'sourceWorkSheet.Copy(, xlWorkBook1.Sheets(xlWorkBook1.Sheets.Count))

    'Tried this
    'xlWorkSheet.Copy(, xlWorkBook1.Sheets(xlWorkBook1.Sheets.Count))

    'tried this
    'xlWorkSheet1.Range("A1:I46").Value = xlWorkSheet.Range("A1:I46").Value
    'xlWorkSheet.Application.Goto(xlWorkSheet.Range("A1:I46"), True)
    'xlWorkSheet.Range("A1:I46").Select()
    'xlWorkSheet.Range("A1:I46").Copy()
    'xlWorkSheet1.PasteSpecial(Excel.XlPasteType.xlPasteAll, 
    'Excel.XlPasteSpecialOperation.xlPasteSpecialOperationNone, False, False)

    'Tried this
    'xlWorkSheet.Range("A1:I46").Copy(xlWorkSheet1.Range("A1:I46"))
    'xlWorkSheet1.PasteSpecial(Excel.XlPasteType.xlPasteFormats)

    xlWorkBook1.SaveAs(BTPath & "\" & xlWorkSheet.Range("B3").Value & ".xls", Excel.XlFileFormat.xlExcel5) 'save the receipt as the ticket number
    If RadioButton3.Checked = True Then
        'unpaid - send copy to unpaid folder
        xlWorkBook1.SaveAs(UnpaidPath & "\" & xlWorkSheet.Range("B3").Value & ".xls", Excel.XlFileFormat.xlExcel5)
    ElseIf RadioButton4.Checked = True Then

    End If

我需要有关复制方法的帮助。

经过更多研究,找到了一种从源书中保存工作表的方法。关闭本书并重新打开源书以继续使用。我现在 运行 遇到的唯一问题是,公式仍在被复制,并且某些单元格的格式不同(粗体、合并、大小),但在 SO 上找到了 link - Save values (not formulae) from a sheet to a new workbook?

新代码:

    'save first
    xlWorkBook.Save() 'Save the workbook

    Dim newpath As String = BTPath & "\" & xlWorkSheet.Range("B3").Value & ".xls"

    xlWorkSheet = CType(xlWorkBook.Sheets("TempPage"), Excel.Worksheet)
    xlWorkSheet.Copy()
    xlWorkSheet.SaveAs(newpath, Excel.XlFileFormat.xlExcel5)

    If RadioButton3.Checked = True Then
        'unpaid - send copy to unpaid folder
        xlWorkBook.SaveAs(BTPath & "\" & xlWorkSheet.Range("B3").Value & ".xls")
    End If

    'Close the file and reopen the database file
    xlWorkBook.Save() 'Save the workbook
    xlWorkBook.Close() 'Close workbook
    If xlApp Is Nothing Then
        'do nothing
    Else
        xlApp.Quit() 'Quit the application
    End If


    GC.Collect()
    GC.WaitForPendingFinalizers()
    System.Threading.Thread.Sleep(500)
    GC.Collect()
    GC.WaitForPendingFinalizers()
    System.Threading.Thread.Sleep(500)

    'reopen
    xlApp = New Excel.Application
    xlWorkBook = xlApp.Workbooks.Open(filepath)

    'clear the sheet
    xlWorkSheet = CType(xlWorkBook.Sheets("TempPage"), Excel.Worksheet)
    xlWorkSheet.Range("D45").Value = ""
    xlWorkSheet.Range("B3").Value = ""
    xlWorkSheet.Range("B10").Value = ""
    xlWorkSheet.Range("F10").Value = ""
    xlWorkSheet.Range("F12").Value = ""
    xlWorkSheet.Range("B11").Value = ""
    xlWorkSheet.Range("F11").Value = ""
    xlWorkSheet.Range("I10").Value = ""
    xlWorkSheet.Range("A14:H10").Value = ""

    'save but don't close
    xlWorkBook.Save() 'Save the workbook