Trying to Combine 2 Macros to Copy Specific Cells from External Workbook Excel Vba

Question

I am trying to combine my two macros below to achieve the following result: In my active worksheet, I have a row that I need to populate with data B7:AD7.

To do this, I have to open another workbook and go to the worksheet that contains that data, copy the cells containing the data into the row I mentioned above. My macro to open an external workbook is activated with a button:

Sub ImportDataFromExternalSource()

    Dim HistoryTool As Workbook
    Dim CWB As Workbook
    Dim TargetSummSheet As Range
    Dim ImportHelper As Range

    Set HistoryTool = ActiveWorkbook

    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xlsx*;*.xlsm*;*.xlsa*;*.xm*"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set CWB = ActiveWorkbook
            Set TargetSummSheet = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A1", Type:=8)
            HistoryTool.Activate
            Set ImportHelper = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1", Type:=8)
            TargetSummSheet.Copy ImportHelper
            ImportHelper.CurrentRegion.EntireColumn.AutoFit
            CWB.Close False
        End If
    End With

End Sub

The problem with this is the user has to manually find the cells to copy on the sheet. The data is always in the same location in any of the workbooks, just not all in 1 column. So C3, C10, I34, H33 etc. My macro to automate the selection process is as follows:

Sub CopyCWBValues()

Dim LR As Long, i As Long, cls

cls = Array("C3", "C4", "C5", "C6", "C10", "C11", "C12", "C13", "C14", "C15", "C16", "C17", "C18", "C20", "C21", "C22", "C23", "C24", "C25", "C26", "C27", "C33", "I34", "", "I35", "I38", "H33", "I40", "I43", "I46")
With Sheets("Import Cost Helper")
    LR = WorksheetFunction.Max(7, .Range("B" & Rows.Count).End(xlUp).Row + 1)
    For i = LBound(cls) To UBound(cls)
        .Cells(LR, i + 1).Value = Me.Range(cls(i)).Value
    Next i
End With
End Sub

What I want to do is for the user to click on the active x button to run the macro, select the workbook, and then select the worksheet and have the macro do the rest. I feel I'm half way there but am stuck and would greatly appreciate any help.

Are you saying that instead of selecting the source and destination cell, they are already determined - cls and B7:AD7? — SJR
@SJR That is correct. I will always be copying to B7:AD7 and the source data will always be in the cls range. — Remi

SJR SJR · Accepted Answer · 2018-04-20T16:26:19

Can you try this? You should add the name of the sheet in CWB from which you are copying. I think you'd done most of the heavy lifting to be honest, just a case of stitching together the two bits of code.

Sub ImportDataFromExternalSource()

Dim HistoryTool As Workbook
Dim CWB As Workbook
Dim TargetSummSheet As Range
Dim cls, LR As Long, i As Long

Set HistoryTool = ActiveWorkbook
cls = Array("C3", "C4", "C5", "C6", "C10", "C11", "C12", "C13", "C14", "C15", "C16", "C17", "C18", "C20", "C21", "C22", "C23", "C24", "C25", "C26", "C27", "C33", "I34", "I35", "I38", "H33", "I40", "I43", "I46")

With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xlsx*;*.xlsm*;*.xlsa*;*.xm*"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count > 0 Then
        Workbooks.Open .SelectedItems(1)
        Set CWB = ActiveWorkbook
        Set TargetSummSheet = Application.InputBox(prompt:="Select source sheet (select any cell)", Title:="Source sheet", Default:="A1", Type:=8)
        With HistoryTool.Sheets("Import Cost Helper")
            For i = LBound(cls) To UBound(cls)
                .Range("B7").Offset(, i).Value = TargetSummSheet.Parent.Range(cls(i)).Value 'may have to adjust CWB sheet ref
            Next i
            .Range("B7:AD7").EntireColumn.AutoFit
        End With
        CWB.Close False
    End If
End With

End Sub

Trying to Combine 2 Macros to Copy Specific Cells from External Workbook Excel Vba

1 Answers