Question

此帖子是我之前post关于同一主题的更好的问题。

我正在尝试从第一张工作表中复制.xls文件中的数据并将其粘贴到我的.xlsm文件中。如果＆＃34; Sheet1＆＃34;中没有数据。 .xlsm然后将源数据粘贴到＆＃34; Sheet1＆＃34; of .xlsm。但是，所有其他数据，新工作表将被创建并粘贴到新创建的工作表中。

但是，目前，我的代码会打开.xls文件并停止。我尝试添加Stop作为一些建议，但这只是关闭了所有的窗口。我非常感谢有关如何解决这个问题的一些意见。如果我可以通过按下一个很棒的按钮来输入复制和粘贴命令。此代码将面向客户，因此只需按一个按钮即可直观，简单地使用。提前谢谢。

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 IsSheetBlank(Sheet As Worksheet) As Boolean
    IsSheetBlank = (WorksheetFunction.CountA(Sheet.Cells) = 0)
End Function

VBA - 将.xls插入.xlsm

2 个答案: