Question

我尝试将从CSV文件打开的工作表中的数据复制为现有Excel模板中的新工作表。我已尝试复制到现有的空工作表，以及将源工作表复制为目标工作簿中的新工作表。所有这些方法都抛出了各种错误。实际允许代码完成的唯一方法是copy-paste-special命令。然而，它导致细胞被二进制填充而不是数值，并且许多细胞被填充了灰色的外观。

以下是我一直努力工作的代码：

'=================================================
'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。

尝试将工作表复制到vba

1 个答案: