尝试将工作表复制到vba中的现有工作簿
我试图从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_AutomationLab 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中运行此代码,方法是单击我已添加到工作表的按钮。
下面的代码适用于我,从工作簿中运行。 ***
标记我改变的东西。
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_AutomationLab 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
由于此问题中列出的问题,我使用自定义工作表名称来查找新工作表。
从Excel内运行时,不需要创建AppExcel
对象。 相反,您可以直接参考Application
。
上一篇: Trying to copy a worksheet to an existing workbook in vba
下一篇: use Excel Objects (Worksheet, Workbooks ...) in Classes/Objects