尝试将工作表复制到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_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中运行此代码,方法是单击已添加到工作表的button。

下面的代码为我工作,从工作簿内运行。 ***标记我改变的东西。

 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 

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

从Excel中运行时不需要创buildAppExcel对象。 相反,您可以直接参考Application