Extracting multiple lines of data from another workbook sheet

**FHSController** · 06-23-2011, 02:59 PM

I have built a workbook and need some help on the final (but crucial) step.

The workbook has a sheet containing a complete download of transaction activity (sheet "DATALINK") that is automatically updated through a data connection with our accounting software.

I then have created separate sheets for each unique account number (column G - "Composite Acct" in the DATALINK sheet). Cell E2 in the individual account sheets (e.g. sheet "116-609") displays the account number associated with that sheet (this account number matches numbers the "Composite Acct" number column in the DATALINK sheet).

What I need to do now is to build formula(s) into the data section of the individual account sheets (columns A thru H, rows 12 thru ??) that will automatically populate with the data from columns L thru S of the DATALINK sheet by finding all the rows where:
[1] column G matches the account number in cell E2 of the individual sheets) and
[2] column K of the DATALINK sheet ("Period") does NOT equal "0".

When finished, the example file attached would then have 2 lines of data in the "116-609" sheet, 42 lines of data in the "118-105" sheet, 17 lines od data in the " 118-210" sheet, etc.

Thanks so much!

**Paul** · 06-23-2011, 05:11 PM

Hi FHSController, welcome to the forum.

Would a macro work for you rather than hundreds or thousands of complex formulas? If so, add the following code to the Datalink sheet's code module and give it a try (use a backup copy of your workbook, of course).

Sub orgData()
Dim ws As Worksheet, dlink As Worksheet, tmpStr As String
Dim i As Long, lastrow As Long, nextrow As Long

Set dlink = Sheets("DATALINK")
lastrow = dlink.Range("A" & Rows.Count).End(xlUp).Row

For Each ws In ThisWorkbook.Worksheets
    If Left(ws.Name, 1) >= 0 And Left(ws.Name, 1) <= 9 Then
        tmpStr = ws.Range("E2").Value
        nextrow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
        For i = 2 To lastrow
            If dlink.Range("G" & i).Value = tmpStr And dlink.Range("K" & i).Value <> 0 Then
                dlink.Range("L" & i & ":S" & i).Copy ws.Range("A" & nextrow)
                nextrow = nextrow + 1
            End If
        Next i
    End If
Next ws
End Sub

The code skips any sheets that don't start with a number (see the first IF statement). Hope that helps!

**FHSController** · 06-24-2011, 09:12 AM

Hi Paul,

Thanks for the quick response.

That macro is phenomenal !! There are only a couple things that I noticed:
1) The macro begins dropping the data in row 9 of the worksheets. I need it to start in row 12 (or better yet, a cell that I name "datastart" or something in case I change something that makes the row change).
2) If you run the macro multiple times, it appends the rows below the previous set. This is very useful, and I would like to keep a copy of the macro that does this (with item #1 fixed) for future use, but in this particular workbook the DATALINK tab is year-to-date information, so I would need this macro to actually clear the existing data section of the sheets (just to be safe) and pull the data back in beginning with the "datastart" cell.

All in all, this is super-cool and is so much better than using formulas. I can't wait to roll this out once it's working. You're going to make me look like a hero!!

Looking forward to hearing from you. I am in your debt.

Troy

**Paul** · 06-24-2011, 11:17 AM

Hi Troy, glad it's helping. To address the issues you raise, try the amended code below. It starts adding data in row 12 on each sheet (nextrow=12) and before adding new data it first clears all data in columns A:H starting at row 12.

I didn't know what you intended to do with columns K:U. If those need to be cleared as well, you can add an additional "ClearContents" line of code below the current one. Just change the column references of course.

Sub orgData()
Dim ws As Worksheet, dlink As Worksheet, tmpStr As String
Dim i As Long, lastrow As Long, nextrow As Long

Set dlink = Sheets("DATALINK")
lastrow = dlink.Range("A" & Rows.Count).End(xlUp).Row

For Each ws In ThisWorkbook.Worksheets
    If Left(ws.Name, 1) >= 0 And Left(ws.Name, 1) <= 9 Then
        tmpStr = ws.Range("E2").Value
        nextrow = 12
        ws.Range("A12:H" & Rows.Count).ClearContents
        For i = 2 To lastrow
            If dlink.Range("G" & i).Value = tmpStr And dlink.Range("K" & i).Value <> 0 Then
                dlink.Range("L" & i & ":S" & i).Copy ws.Range("A" & nextrow)
                nextrow = nextrow + 1
            End If
        Next i
    End If
Next ws
End Sub