Excel - copying relevant information from multiple files 2

[OMoore]

Hi All,

This query may be a little too advanced for this forum but here goes anyway!

I have 66 Excel files each of which contains information I need. I need to copy it from it's current file to a new worksheet, pasting from each file I open.

The data I need is identified in the spreadsheet with a number on the row before the information begins and a number on the row after...etc

500.0018
all required information here
all required information here
all required information here
500.0018

I'd like to be able to open the file, quickly go to the lines I need, copy them and paste into an open workbook.

Any ideas that could point me on the right track?

Thanks
Owen

 

[AnotherHiggins]

The easiest way to do this for all files will be to loop through all files in a given folder structure.

Are all 66 files in the same folder?
Are there other excel files in the same folder(s)?
Are the column headings/column order the same in each file?

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ181-2886 before posting.

 

[OMoore]

Thanks John

Are all 66 files in the same folder? Yes
Are there other excel files in the same folder(s)? No
Are the column headings/column order the same in each file? Yes

Owen

 

[AnotherHiggins]

OK. Let's start by getting the basics of what you want to do with each file that we loop through.

To do this, open one of the files, and then use Tools > Macro > Record New Macro to turn on the macro recorder.

Go through the steps of copying the data (we can clean up how it finds "500.0018" later) and pasting it to a new workbook.

Once you're done, press [Ctrl]+[F11] to view the code that was recorded. Post that code back here and we'll clean it up some.

Then you'll take that cleaned code and place it in a loop that will look something like this:

Set fs = Application.FileSearch
    With fs
    .LookIn = "C:\Your\Path\Here"
    .Filename = "*.xls"
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                Workbooks.Open .FoundFiles(i)
                    'Your Code Here
            Next i
        End If
    End With
Set fs = Nothing

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ181-2886 before posting.

 

[OMoore]

My code is.....

Sheets("Detail").Select
Rows("82:89").Select
Selection.Copy
Windows("Summary.xls").Activate
ActiveSheet.Paste
Range("A9").Select

 

[AnotherHiggins]

Try this:

Sub ConsolidateFiles()
Workbooks.Add
TargetBook = ActiveWorkbook.Name

Set fs = Application.FileSearch
    With fs
    .LookIn = "C:\Your\Path\Here"
    .Filename = "*.xls"
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                Workbooks.Open .FoundFiles(i)
                FirstRow = Sheets("Detail").Columns("A:A").Find(What:="500.0018", _
                  LookAt:=xlWhole).Row + 1
                LastRow = Sheets("Detail").Columns("A:A").FindNext _
                  (After:=Range("A" & FirstRow)).Row - 1
                    Sheets("Detail").Range(FirstRow & ":" & LastRow).Copy _
                      Destination:=Workbooks(TargetBook). _
                      Worksheets(1).Range("A65536"). _
                      End(xlUp).Offset(1, 0)
            Next i
        End If
    End With
Set fs = Nothing
End Sub

You'll obviously want to change "C:\Your\Path\Here" to your folder path.

Also, this code assumes that the data is always on a sheet entitled "Detail".

Post back with any problems.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ181-2886 before posting.

 

[OMoore]

Hello John,

Sorry for the delay in replying.

I am getting the following error:

Runtime Error 91:
Object variable or With block variable not set

I've got the following code:

Sub ConsolidateFiles()
Workbooks.Add
TargetBook = ActiveWorkbook.Name

Set fs = Application.FileSearch
    With fs
    .LookIn = "C:\Owen Files"
    .Filename = "*.xls"
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                Workbooks.Open .FoundFiles(i)
                FirstRow = Sheets("Detail").Columns("A:A").Find(What:="500022116.5920.16", _
                  LookAt:=xlWhole).Row + 1
                LastRow = Sheets("Detail").Columns("A:A").FindNext _
                  (After:=Range("A" & FirstRow)).Row - 1
                    Sheets("Detail").Range(FirstRow & ":" & LastRow).Copy _
                      Destination:=Workbooks(TargetBook). _
                      Worksheets(1).Range("A65536"). _
                      End(xlUp).Offset(1, 0)
            Next i
        End If
    End With
Set fs = Nothing

End Sub

Thanks
Owen

 

[xlbo]

what line does it highlight for the error ?

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[OMoore]

It has worked. The information I'm searching for is actually in column B so I needed to change the reference from column A.

Thanks John

 

[AnotherHiggins]

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ181-2886 before posting.