VBA-將.xls插入.xlsm

Question

這篇文章比我以前的文章中關於同一主題的問題更好。

我正在嘗試從.xls文件中僅復制第一張工作表的數據並將其粘貼到我的.xlsm文件中。 如果.xlsm的“ Sheet1”中沒有數據，則將源數據粘貼到.xlsm的“ Sheet1”中。 但是，對於所有其他數據，將創建一個新工作表並將其粘貼到該新創建的工作表中。

但是，當前，我的代碼打開.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()過程。 存在兩個語法問題（可以通過預先編譯代碼來解決），並且在理解運行時會發生什么方面也存在一些錯誤。

最值得注意的是，當檢查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

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