CODEWITHSUNDEEP
vbaexcel
A Cohen
A Cohen

Reputation: 456

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. If there is no data in the "Sheet1" of .xlsm then paste source data into "Sheet1" of .xlsm. 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. I tried adding Stop as some suggested, but that just closed all the windows. 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

Upvotes: 1

Views: 835

Answers (2)

Profex
Profex

Reputation: 1390

While @ScottHoltzman grabs a coffee :) try this...

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

Upvotes: 0

Scott Holtzman
Scott Holtzman

Reputation: 27239

I have refactored the ReadDataCloseFile() procedure. 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.

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

Upvotes: 2

Related Questions