首页 文章

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

提问于
浏览 次
1

我正在尝试从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中运行此代码 .

excel vba excel-vba

1 回答

  • 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 .

    回复于

相关问题