尝试将工作表复制到 vba 中的现有工作簿

Question

我正在尝试复制从 CSV 文件打开的工作表中的数据，作为现有 Excel 模板中的新工作表。我已尝试复制到现有的空工作表，以及将源工作表复制为目标工作簿中的新工作表。所有这些方法都引发了各种错误。真正允许代码完成的唯一方法是复制粘贴特殊命令。然而，它导致单元格被填充为二进制而不是值，并且许多单元格被填充为灰色的外观。

下面是我一直在尝试的代码：

'=================================================
'Add Data
'=================================================
Dim AppExcell As Object
Dim wb As Object
Dim xFile As String
Dim main As Workbook

Set AppExcel = CreateObject("Excel.Application")
AppExcel.Visible = False

Set wb = AppExcel.Workbooks.Add("C:\Fridge_Automation\Lab Report.xltm")
Set main = ActiveWorkbook

xFile = Application.GetOpenFilename("All CSV Files (*.csv),*.csv", , "Select CSV File")

Set src = Workbooks.Open(xFile)

src.Worksheets(1).Copy Before:=wb.Worksheets("11Mic Avg - Raw Data")
wb.Worksheets(2).Name = "Raw Data"
src.Close

我正在 Excel 2013 中运行此代码，方法是单击我添加到工作表中的按钮。

Answer 1

下面的代码对我有用，从工作簿中运行。 *** 标记我更改的内容。

Option Explicit             ' *** Always use this in every module
Option Base 0

Public Sub GrabSheet()

    'Dim AppExcel As Object ' *** don't need this
    'Dim wb As Object       ' ***
    Dim dest As Workbook    ' *** Instead of "wb"
    Dim xFile As String
    'Dim main As Workbook   ' ***

    'Set AppExcel = CreateObject("Excel.Application")   ' ***
    'AppExcel.Visible = False   ' ***
    'Application.Visible = False ' *** Uncomment if you really want to...

    Set dest = ActiveWorkbook   ' *** for testing - use Workbooks.Add("C:\Fridge_Automation\Lab Report.xltm") for your real code
    'Set main = ActiveWorkbook  ' *** don't need this

    xFile = Application.GetOpenFilename("All CSV Files (*.csv),*.csv", , "Select CSV File")

    Dim src As Workbook     ' *** Need to declare this because of "Option Explicit"
    Set src = Workbooks.Open(xFile)

    ' Per https://stackoverflow.com/q/7692274/2877364 , it is surprisingly
    ' difficult to get the new sheet after you copy.
    ' Make a unique name to refer to the sheet by.
    Dim sheetname As String                         ' ***
    sheetname = "S" & Format(Now, "yyyymmddhhmmss") ' ***
    src.Worksheets(1).Name = sheetname              ' ***

    src.Worksheets(1).Copy Before:=dest.Worksheets("11Mic Avg - Raw Data")  ' *** changed wb to dest
    'dest.Worksheets(2).Name = "Raw Data"           ' *** don't assume an index...
    dest.Worksheets(sheetname).Name = "Raw Data"    ' *** ... but use the name.
        ' *** NOTE: this fails if a "Raw Data" sheet already exists.
    src.Close SaveChanges:=False  ' *** Suppress the "save changes" prompt you otherwise get because of the `src...Name` assignment

End Sub

由于this question 中列出的问题，我使用自定义工作表名称来查找新工作表。

当您在 Excel 中运行时，无需创建 AppExcel 对象。相反，您可以直接参考Application。