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

Question

努力将工作表从源书复制到目标书。 我尝试了在 SO 上找到的 4 种不同的代码，但总是遇到不同的错误。 要么：“复制方法失败”、“未找到此类接口”、“异常”- 在复制函数中。

我知道有很多链接和网站都提到了复制方法，但我都试过了，仍然没有运气。

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

Excel 2016 VS 2019

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

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

Answer 1

经过一番研究，找到了一种方法来保存源书中的工作表。关闭书并重新打开源书以继续使用。我现在遇到的唯一问题是公式仍在复制中，并且某些单元格的格式不同（粗体、合并、大小），但在 SO - 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