[英]VBA - Insert .xls into .xlsm
This post is a better posed question from my previous post regarding the same topic. 这篇文章比我以前的文章中关于同一主题的问题更好。
I am attempting to copy data from an .xls file just the first sheet and paste it into my .xlsm file. 我正在尝试从.xls文件中仅复制第一张工作表的数据并将其粘贴到我的.xlsm文件中。 If there is no data in the "Sheet1" of .xlsm then paste source data into "Sheet1" of .xlsm. 如果.xlsm的“ Sheet1”中没有数据,则将源数据粘贴到.xlsm的“ Sheet1”中。 However, all other data, a new sheet will be created and pasted into that newly created sheet. 但是,对于所有其他数据,将创建一个新工作表并将其粘贴到该新创建的工作表中。
However, currently, my code opens up the .xls file and stops. 但是,当前,我的代码打开.xls文件并停止。 I tried adding Stop
as some suggested, but that just closed all the windows. 我尝试按照一些建议添加“ Stop
,但这只是关闭了所有窗口。 I would greatly appreciate some input on how to solve this issue. 我非常感谢您提供一些有关如何解决此问题的意见。 If I can just put in a copy and paste command that works by pressing one button that's great. 如果我只需按一下一个按钮就可以执行复制和粘贴命令。 This code will be for a customer so it needs to be intuitive and simple to use by just pressing one button. 此代码适用于客户,因此只需按一个按钮就需要直观且易于使用。 Thanks in advance. 提前致谢。
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
I have refactored the ReadDataCloseFile()
procedure. 我已经重构了ReadDataCloseFile()
过程。 There were a couple of syntax issues (can be solved by compiling code beforehand) and also some mistakes in understanding what happens during run-time. 存在两个语法问题(可以通过预先编译代码来解决),并且在理解运行时会发生什么方面也存在一些错误。
Most notably when checking the value of range Worksheets("Sheet1")
, if you don't qualify the specific workbook the code will use the ActiveWorkbook
, which in this case will be src
, not the workbook you want to check, which I assume is the Workbook with the code. 最值得注意的是,当检查range 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
While @ScottHoltzman grabs a coffee :) try this... @ScottHoltzman喝咖啡时:)试试这个...
Change the call to include the current workbook. 更改呼叫以包括当前工作簿。
Call ReadDataFromCloseFile(fNameAndPath, wkbCrntWorkBook)
And to main worker... 对于主要工人
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
Helper Function... 辅助功能...
Function IsSheetBlank(Sheet As Worksheet) As Boolean
IsSheetBlank = (WorksheetFunction.CountA(Sheet.Cells) = 0)
End Function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.