Importing specific cell data from one workbook to another

Lelewiwi

Board Regular
Joined
Nov 8, 2023
Messages
50
Office Version
  1. 365
Platform
  1. Windows
Good morning,

I've been working on this for days and am getting a little frustrated. I am trying to import specific cell data from Workbook1 to Workbook2. This needs to be an on-demand action so a button would be best to simplify matters. The button should be on Workbook2 as Workbook1 will change every time. I have never written code nor even looked at anything resembling code so please bear with me and give me simple instructions.

I would like the button to do the following actions:
*Open a window to select Workbook1
*Once Workbook1 is selected, import multiple specific cell data to Workbook2

Data will be a mixture of text, numbers and formulas.

Below is what I have so far. The choose file part works great, however, I get a "Subscript out of range" error when it tries to import the data.

Thanks for the help!

Public Sub subImportData()
Dim fd As Office.FileDialog
Dim strFile As String
Dim WbThisWorkbook As Workbook
Dim WbImportFrom As Workbook

ActiveWorkbook.Save

Application.ScreenUpdating = False

Set WbThisWorkbook = ThisWorkbook

Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd

.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx?", 1
.Filters.Add "Excel Files", "*.xlsm?", 1
.Title = "Choose an Excel file"
.AllowMultiSelect = False

.InitialFileName = ActiveWorkbook.Path

If .Show = True Then

strFile = .SelectedItems(1)

End If

End With

If strFile = "" Then
Application.ScreenUpdating = True
Exit Sub
End If

Workbooks.Open strFile, ReadOnly:=True
Set WbImportFrom = ActiveWorkbook

WbThisWorkbook.Sheets("Sheet1").Range("H7").Value = WbImportFrom.Sheets("Sheet1").Range("B1").Value
WbThisWorkbook.Sheets("Sheet1").Range("R5").Value = WbImportFrom.Sheets("Sheet1").Range("B2").Value
WbThisWorkbook.Sheets("Sheet1").Range("E25").Value = WbImportFrom.Sheets("Sheet2").Range("C27").Value
WbThisWorkbook.Sheets("Sheet1").Range("E26").Value = WbImportFrom.Sheets("Sheet2").Range("C28").Value
WbThisWorkbook.Sheets("Sheet1").Range("E27").Value = WbImportFrom.Sheets("Sheet2").Range("C29").Value
WbThisWorkbook.Sheets("Sheet1").Range("D32").Value = WbImportFrom.Sheets("Sheet1").Range("B7").Value

WbImportFrom.Close

Application.ScreenUpdating = True

ActiveWorkbook.Save

End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Below is what I have so far. The choose file part works great, however, I get a "Subscript out of range" error when it tries to import the data.

In general that error means that some element or object that you are counting on is missing. With your code it could mean that the workbook you open does not have a "Sheet1" for example.

This version has some code to check for that.

VBA Code:
Public Sub subImportData()
    Dim fd As Office.FileDialog
    Dim strFile As String
    Dim WbThisWorkbook As Workbook
    Dim WbImportFrom As Workbook
    Dim srcWS As Worksheet, destWS As Worksheet
    Dim Found As Boolean
    
    ActiveWorkbook.Save
    
    Application.ScreenUpdating = False
    
    Set WbThisWorkbook = ThisWorkbook
    
    On Error Resume Next
    Set destWS = WbThisWorkbook.Worksheets("Sheet1")
    On Error GoTo 0
    
    If destWS Is Nothing Then
        MsgBox """Sheet1"" not found in " & WbThisWorkbook.Name, vbOKOnly Or vbCritical, "Error"
        Exit Sub
    End If
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    With fd
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xlsx?", 1
        .Filters.Add "Excel Files", "*.xlsm?", 1
        .Title = "Choose an Excel file"
        .AllowMultiSelect = False
        
        .InitialFileName = ActiveWorkbook.Path
        
        If .Show = True Then
            
            strFile = .SelectedItems(1)
            
        End If
        
    End With
    
    If strFile = "" Then
        Application.ScreenUpdating = True
        Exit Sub
    End If

    Set WbImportFrom = Workbooks.Open(strFile, ReadOnly:=True)
    
    For Each srcWS In WbImportFrom.Worksheets
        With destWS
            Select Case srcWS.Name
                Case "Sheet1"
                    Found = True
                    .Range("H7").Value = srcWS.Range("B1").Value
                    .Range("R5").Value = srcWS.Range("B2").Value
                    .Range("D32").Value = srcWS.Range("B7").Value
                Case "Sheet2"
                    Found = True
                    .Range("E25").Value = srcWS.Range("C27").Value
                    .Range("E26").Value = srcWS.Range("C28").Value
                    .Range("E27").Value = srcWS.Range("C29").Value
            End Select
        End With
    Next srcWS
    
    If Not Found Then
        MsgBox "Source worksheets not found in:" & vbCr & WbImportFrom.Name, vbOKOnly Or vbCritical, "Error"
    End If
    
    WbImportFrom.Close False
    Application.ScreenUpdating = True
    ActiveWorkbook.Save
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top