Change from interface to Cell, specify range

Question

currently the code below will copy two spreadsheets into the macro sheet.

Problem: I want to use Excel cells to specify a file path (from cell A1, A2 or wherever), a sheet name (from cell B1, B2), and a corresponding specified cell range (in cells C1, C2) instead of having to browse to each file with the Application.

Option Explicit

Sub Sample()
Dim wb1 As Workbook: Set wb1 = ThisWorkbook
Dim wb2 As Workbook
Dim i As Long
Dim wsNew As Worksheet
Dim ws As Worksheet: Set ws = wb1.Sheets("Sheet1")
Dim LastRow
Dim sheetName As String
Dim rangeStart As String
Dim rangeEnd As String
Dim ws2 As Worksheet
Dim CellValueToCopy As String
'declare and set your worksheet with your filenames
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data by finding the last item in Column A

For i = 2 To LastRow 'loop from Row 2 to Last in Sheet1 of this workbook
    Set wb2 = Workbooks.Open(ws.Cells(i, "A")) 'open the file stored in Column A of Sheet1 of this workbook
    sheetName = ws.Cells(i, "B")
    rangeStart = ws.Cells(i, "C")
    rangeEnd = ws.Cells(i, "D")
       'wb2.Sheets(ws.Cells(i, "B").Value).range(ws.Cells(i, "C").Value).Copy
    Set ws2 = wb2.Worksheets(sheetName)
    wb1.Sheets.Add
    wb1.ActiveSheet.Name = sheetName + "_added"
    ' the below is a proof of concept to copy the values
    ' loop through the range rather than just one cell to get the final copy
    CellValueToCopy = ws2.Cells(1, 1)
    wb1.ActiveSheet.Cells(1, 1) = CellValueToCopy
    ' close workbook and reset variables
    wb2.Close SaveChanges:=False
    Set wb2 = Nothing
    Set wsNew = Nothing
    Set ws2 = Nothing
Next i

End Sub

I'm kind of lost; do I accept a string (such as filepath, range, etc.) from the cells I want? Instead of using .Copy, how do I specify an active range in the sheets? — J. Smith
E.g. if you have a valid path in A1 you can use Workbooks.Open (Range("A1").Value). Of course you need to qualify the range with a sheet and a workbook as you are working with multiple files. The same principle applies to sheets etc. — SJR

Xabier Xabier · Accepted Answer · 2018-03-05T16:02:18

How about something like the following, this will loop through your column A, open the given filename, and copy the Range from Column C from the Sheet in Column B and paste into a new sheet in the current workbook:

Option Explicit

Sub Sample()
    Dim wb1 As Workbook: Set wb1 = Workbooks("Change from interface to Cell specify range.xlsm")
    Dim wb2 As Workbook
    Dim i As Long, LastRow As Long
    Dim wsNew As Worksheet
    Dim ws As Worksheet: Set ws = wb1.Sheets("Sheet1")
    'declare and set your worksheet with your filenames, amend as required
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    'get the last row with data on Column A

    For i = 2 To LastRow 'loop from Row 2 to Last in Sheet1 of this workbook
        Set wb2 = Workbooks.Open(ws.Cells(i, "A")) 'open the file stored in Column A of Sheet1 of this workbook
        wb2.Sheets(ws.Cells(i, "B").Value).Range(ws.Cells(i, "C").Value).Copy
        'above specify the sheet from Column B of Sheet1 and the Range from Column C
        'if you have starting range at Column C and end range at Column D then the line below will copy the specified range
        'wb2.Sheets(ws.Cells(i, "B").Value).Range(ws.Cells(i, "C").Value & ":" & ws.Cells(i, "D").Value).Copy

        Set wsNew = wb1.Sheets.Add(After:=wb1.Sheets(wb1.Sheets.Count))
        wsNew.Name = "Blah Blah " & (i - 1)
        'above add a new sheet and name accordingly, I used the counter i to number the sheets
        wsNew.Range("A1").PasteSpecial xlPasteAll
        wb2.Close SaveChanges:=False
        Set wb2 = Nothing
        Set wsNew = Nothing
    Next i
End Sub

Change from interface to Cell, specify range

1 Answers