VBA – 将.xls插入.xlsm

这篇文章是从我以前的post关于同一主题更好的提出的问题。

我正在尝试从.xls文件中复制数据，只是将其粘贴到我的.xlsm文件中。 如果.xlsm的“Sheet1”中没有数据，则将源数据粘贴到.xlsm的“Sheet1”中。 但是，所有其他数据，一个新的工作表将被创build并粘贴到新创build的工作表。

但是，目前，我的代码打开.xls文件并停止。 我试着按照一些build议添加Stop ，但是这只是closures了所有的窗口。 我将不胜感激关于如何解决这个问题的一些input。 如果我可以放一个复制和粘贴命令，通过按下一个很好的button来工作。 这个代码将是一个客户，所以只需按一个button，它就需要直观和简单的使用。 提前致谢。

 Sub ImportData() Dim wkbCrntWorkBook As Workbook Dim wkbSourceBook As Workbook Dim fNameAndPath As Variant Set wkbCrntWorkBook = ActiveWorkbook fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel 2007, *.xls; *.xlsx; *.xlsm; *.xlsa", Title:="Select File To Import") If fNameAndPath = False Then Exit Sub Call ReadDataFromCloseFile(fNameAndPath) Set wkbCrntWorkBook = Nothing Set wkbSourceBook = Nothing End Sub Sub ReadDataFromCloseFile(filePath As Variant) Application.ScreenUpdating = False Dim src As Workbook Set src = Workbooks.Open(filePath, False, False) Stop Application.Visible = False ' COPY DATA FROM SOURCE (CLOSE WORKGROUP) TO THE DESTINATION WORKBOOK. ' GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK. Dim srcRng As Range ' last line from source Set srcRng = src.Worksheets("Sheet1").Range("A1", src.Worksheets("Sheet1").Range("A1")).End(xlDown) Set srcRng = srcRng.End(xlToRight) If Worksheets("Sheet1").Range("A1") = "" Then Worksheets("Sheet1").Range("A1") = srcRng Else: Worksheets.Add After:=(Sheets.Count) Worksheets("Sheet" & Sheets.Count).Range("A1") = srcRng End If ' CLOSE THE SOURCE FILE. src.Close False ' FALSE - DON'T SAVE THE SOURCE FILE. Set src = Nothing Application.Visible = True Application.EnableEvents = True Application.ScreenUpdating = True End Sub 

Answer 1

我重构了ReadDataCloseFile()过程。 有几个语法问题（可以通过事先编译代码来解决）以及在运行时发生的一些错误。

最值得注意的是，当检查范围Worksheets("Sheet1")的值时，如果您没有限定特定的工作簿，代码将使用ActiveWorkbook ，在这种情况下将是src ，而不是您要检查的工作簿，我假设是代码的工作簿。

 Option Explicit Sub ReadDataFromCloseFile(filePath As Variant) Application.ScreenUpdating = False Dim src As Workbook Set src = Workbooks.Open(filePath, False, False) ' COPY DATA FROM SOURCE (CLOSE WORKGROUP) TO THE DESTINATION WORKBOOK. ' GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK. Dim srcRng As Range ' last line from source With src.Worksheets("Sheet1") Set srcRng = .Range(.Range("A1"), .Range("A1").End(xlDown).End(xlToRight)) End With With ThisWorkbook If .Worksheets("Sheet1").Range("A1") = "" Then .Worksheets("Sheet1").Range("A1").Resize(srcRng.Rows.Count,srcRng.Columns.Count).Value = srcRng.Value Else: .Worksheets.Add After:=(.Sheets.Count) .Worksheets(.Sheets.Count).Range("A1").Resize(srcRng.Rows.Count,srcRng.Columns.Count).Value = srcRng.Value End If End With ' CLOSE THE SOURCE FILE. src.Close False ' FALSE - DON'T SAVE THE SOURCE FILE. Set src = Nothing End Sub 

Answer 2

当@ScottHoltzman抓住咖啡:)试试这个…

将呼叫更改为包含当前工作簿。

 Call ReadDataFromCloseFile(fNameAndPath, wkbCrntWorkBook) 

对主要工作人员…

 Sub AppendDataFromFile(filePath As Variant, targetBook As Workbook) Dim src As Workbook On Error GoTo errHandler Application.ScreenUpdating = False Application.EnableEvents = False Set src = Workbooks.Open(filePath, False, False) ' COPY DATA FROM SOURCE (CLOSE WORKGROUP) TO THE DESTINATION WORKBOOK. ' GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK. src.Worksheets(1).Cells.Copy With targetBook If IsSheetBlank(.Worksheets(1)) Then .Worksheets(1).Cells(1, 1).Paste Else Dim x As Worksheet .Worksheets.Add After:=.Sheets(.Sheets.Count) .Worksheets(.Sheets.Count).Paste End If End With ' CLOSE THE SOURCE FILE. src.Close False ' FALSE - DON'T SAVE THE SOURCE FILE. Set src = Nothing errHandler: If Err <> 0 Then MsgBox "Runtime Error: " & Err.Number & vbCr & Err.Description, , "AppendDataFromFile" End If Application.EnableEvents = True Application.ScreenUpdating = True End Sub 

助手function…

 Function IsSheetBlank(Sheet As Worksheet) As Boolean IsSheetBlank = (WorksheetFunction.CountA(Sheet.Cells) = 0) End Function