Solution 1: Formula
This method is unorthodox but I had fun writing it.... If I was doing this for myself then I probably would have turned to VBA or Power Query.
Before we start, you need to make sure both files are open and that they can be referenced. Test this by clicking in an empty cell of the second workbook (destination) and typing =
then click in any cell of the first workbook (source) and press Enter
. Now look in the formula bar where you typed =
, you should see something like ='[Book1]Sheet1'!$A$1
If you do not see anything after the =
then try resizing the two workbooks so they are both displayed on the screen and try again. If you still only see the =
then try closing the source workbook and opening it from inside the destination workbook's File Menu
and try again. If that still doesn't work then neither solution can help you because they need the workbooks need to recognize each other.
You also need to make sure the worksheets in the source file are match the sample data you provided, meaning they are named Sheet1
, Sheet2
, Sheet3
, etc. If they are not named this way then you need to stand facing the corner for an hour so you can consider what else may have been misrepresented in the example you provided.
We're almost ready to start, so go ahead and maximize the destination file window because we're going to do all our work in there; but do not close the source, it needs to remain open.
We begin by typing the name of the source workbook in cell I1
of the destination. Do not use any special characters. If the test you did looks like ='[Book1]Sheet1'!$A$1
then you only type Book1
into cell I1
. Remember, this is all inside the destination sheet.
Now copy each of the following three formulas and paste them in the destination sheet.
Copy ="'["&$I$1&"]Sheet0'!"
and paste into H1
Copy =IF(MOD(ROW()-ROW($D$2),4)=0,LEFT($H$1,FIND("0",$H$1)-1)&VALUE(MID(H1,FIND("0",$H$1),FIND("!",H1)-1-FIND("0",$H$1)))+1&"'!J2",LEFT(H1,FIND("J",H1))&VALUE(MID(H1,FIND("J",H1)+1,LEN(H1)))+9)
and paste into H2
Copy =OFFSET(INDIRECT($H2),0,COLUMN()-COLUMN($B$2),1,1)
and paste into B2
If you did everything right, cell B2
will have data from cell J2
in your source sheet and you can use B2
to populate the range B2:G2
. Do this by dragging or copying and pasting, either works.
At this point, Row 2
should be populated from B:H
and you should see data from the source file in B:G
and you can copy B2:H2
down the sheet as far as you need to go.
When you are satisfied with the results, you can copy your data range and paste over it using Paste Special Values
. This will keep the data but break the links to the source file so you can safely remove Column H
.
Solution 2: VBA
I made this more complicated than it really needs to be but it is still easy to follow and use.
- Begin by closing all of your workbooks and completely closing out of
Excel.
- Now create a new workbook then save it with a recognizable name.
- Open the VBA editor from inside this workbook by pressing
Alt F11
.
- Activate the project explorer from inside the VBA editor by pressing
Ctrl R
. It is probably on the left side of your screen.
- Locate your workbook's VBAProject in the project explorer.
- Right click on your workbook's VBAProject in the project explorer.
- Expand the
Insert
menu and select Module
- Find
Module1
under your workbook's project in the Modules
folder.
- Double left click
Module1
- Left click inside the large white area in the center of the VBA
editor and confirm the window title ends with
[Module1(Code)]
- Copy the code below and paste it inside the editor.
- Close the VBA editor and go back to Excel.
- I recommend saving the workbook as a macro enabled workbook before
continuing.
- Left click the
View
tab on the Excel ribbon.
- Left click the
Macro
icon -or- left click the Macro
drop down
menu and select View Macros
NOTE: your security settings
determine what happens next.
- If your security settings allow macros then select
CopyDataFromWorkbook
and left click Run
If your security settings prevent you from running any macros, you can try change them yourself by opening the File
menu in Excel, selecting Options
, Trust Center
, clicking the Trust Center Settings
button, selecting Macro Settings
in the left panel and setting the appropriate level. As a rule, I do not recommend enabling all macros and my personal preference is to only run signed macros but getting you setup for that is beyond the scope of this post.
We just installed the macro in a workbook that is unrelated to your source and destination files to protect your data from any possible error. I made it flexible enough so that you can install it directly in the source or the destination if you choose.
What to expect when running the macro
The macro asks if the source sheet is open.
If you select yes, it lists every workbook that it can see and asks you to select the source. Not Listed
option was included because it is possible for the source to be open but not visible if it is in a different Excel instance (same problem with the formula above)
If you select no, a window opens and allows you to select the source workbook.
The macro then asks if the destination sheet is open and you follow the same steps. If you selected the source from a list of open workbooks then that workbook will not be listed for you to select as the destination.
From there it loops through every sheet in the source writing to the destination one row at a time. I can speed it up a bit if you find it works too slow but I think your data set is small enough that you will not really notice.
Copty this code and paste it into Module1
of your VBA project
Option Explicit
Sub CopyDataFromWorkbook()
Dim srcWorkbook As Workbook
Dim dstWorkbook As Workbook
Dim srcWorksheet As Worksheet
Dim dstWorksheet As Worksheet
Dim srcActiveRow As Long
Dim dstActiveRow As Long
Dim arydata()
Set srcWorkbook = GetAppropriateWorkbook("source file")
If Not srcWorkbook Is Nothing Then Set dstWorkbook = GetAppropriateWorkbook("destination file", srcWorkbook)
If Not dstWorkbook Is Nothing Then
dstActiveRow = 2
dstWorkbook.Activate
Set dstWorksheet = dstWorkbook.Sheets(1)
For Each srcWorksheet In srcWorkbook.Worksheets
For srcActiveRow = 2 To 29 Step 9
arydata = srcWorksheet.Range("J" & srcActiveRow, "O" & srcActiveRow)
dstWorksheet.Range("B" & dstActiveRow, "G" & dstActiveRow) = arydata
dstActiveRow = dstActiveRow + 1
Next srcActiveRow
Next srcWorksheet
dstWorkbook.Activate
ActiveWindow.Visible = True
End If
End Sub
Private Function GetAppropriateWorkbook(ByVal strRole As String, Optional SelectedWorkbook As Workbook) As Workbook
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
If MsgBox("Is the " & strRole & " open?", vbQuestion + vbYesNo, "FINDING " & UCase(strRole)) = vbYes Then
Set ws = ListOpenWorkbooks(SelectedWorkbook)
On Error Resume Next
Set rng = Application.InputBox("Select the " & strRole & " and click 'OK'", Title:="ACTIVATE " & UCase(strRole), Type:=8)
Set wb = Application.Workbooks(rng.Value)
On Error GoTo 0
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
If wb Is Nothing Then
MsgBox "Could not detect the " & strRole & ". Trying a different way."
End If
End If
If wb Is Nothing Then
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Title = "Find and open the " & strRole
.Filters.Add UCase(Space(2) & strRole & Space(40)), "*.xls; *.xlsx; *.xlsm", 1
.AllowMultiSelect = False
.Show
If .SelectedItems.Count = 1 Then
Application.ScreenUpdating = False
Set wb = Workbooks.Open(Mid(.SelectedItems(1), InStrRev(.SelectedItems(1), "\") + 1, Len(.SelectedItems(1))))
ThisWorkbook.Activate
Application.ScreenUpdating = True
End If
End With
End If
If wb Is Nothing Then
MsgBox "Cannot continue without a " & strRole, vbCritical, "No " & strRole & " selected"
Else
Set GetAppropriateWorkbook = wb
End If
End Function
Private Function ListOpenWorkbooks(Optional SelectedWorkbook As Workbook) As Worksheet
Dim ws As Worksheet
Dim wb As Workbook
Dim s As String
Dim i As Long
If Not SelectedWorkbook Is Nothing Then s = SelectedWorkbook.Name
i = 1
Set ws = ThisWorkbook.Worksheets.Add
For Each wb In Application.Workbooks
If s <> wb.Name Then
ws.Cells(i, 1) = wb.Name
i = i + 1
End If
Next
ws.Cells(i, 1) = "Not listed"
Set ListOpenWorkbooks = ws
End Function