On Aug 24, 1:33*pm, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
> Hi Loop
>
> See the filter example on this page
> Maybe you can use that ?http://www.rondebruin.nl/copy3.htm
>
> --
>
> Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>
>
>
> "Loop" <trustmeiamser...@yahoo.ca> wrote in messagenews:89859b1a-adcd-4b9e-b273-(E-Mail Removed)...
> > There are approximately 20 workbooks with 200 spreadsheets which
> > contain 200 tables in the same columns. Is it possible to consolidate
> > all data under one spreadsheet "data"? I have a code to bring all data
> > onto a sheet "Data" then I have to process it to combine data. Instead
> > of bringing all info I 'd like that a macro looked for the same
> > account, in a range on a "data" sheet(I'll put all accounts under say
> > column A), in other spreadsheets to count totals for all of them. All
> > totals on all spreadsheets for each account are under column "U".
> > To summarize: *I want to combine 200 tables into one. My tables look
> > like:Column A - Accounts, all other columns - data. I need to take
> > data only from column U.
> > This is a part of my table(all tables have different amount of accts):
> > APR-08 MAY-08 JUN-08 JUL-08
> > 75000008 AMORT MAJOR EQUIP INTERNAL 0 0 0 0
> > 81020000 REFERRED OUT LAUNDRY CHRGES 0 0 0 0
> > 41020000 PAPER STOCK 0 0 0 0
> > 41515000 CONTAINERS FOR WASTE DISPOSAL 0 0 0 0
> > 43500000 SUPPLIES PLANT MAINTENANCE 0 0 0 0
> > 49010002 BOOKS JOURNALS & SUBCRIPTIONS 0 0 0 0
> > 49510001 DEPARTMENT SUPPLIES GENERAL 0 0 0 0
> > 47000001 CLINCIAL LAB SUPPLIES 0 900 0 0
> > 62300000 TRAVEL EXPENSE - STAFF 0 300 0 300
> > 62310000 LOCAL TRAVEL - NOT SERV REC 0 0 0 0
> > 61015000 DELIVERY AND COURIER 0 0 0 0
> > 61015001 INVENT FREIGHT CHARGES 0 0 0 0
> > 61500000 CONT ED FEES & MATERIALS 0 0 0 0
> > 64020099 ITS CHARGEOUTS DATA COMMUMIC 0 0 0 0
> > 66030000 ACCREDITATION FEES 0 0 0 0
> > 69600000 MEETING EXPENSE 0 0 500 0
> > 71020000 EQUIP MAINT CONTRACT 0 0 0 0
> > 76500001 MINOR EQUIP FURNITURE 0 0 0 0
> > 76500002 MINOR EQUIP COMPUTER 0 0 0 0
> > 76500003 MINOR EQUIP OTHER 0 0 0 0
> > 0 1200 500 300
> > This is a code:
>
> > Public Sub getData()
> > *'On Error Resume Next
> > *Dim pth As String, fnm As String
> > *Dim tb As Worksheet
> > *Dim lc As Range
>
> > *Application.ScreenUpdating = False
> > *Application.DisplayAlerts = False
>
> > *Set wa = ActiveSheet
> > *Set wd = ThisWorkbook.Sheets("Data")
> > *wd.Activate
> > *Set lc = ActiveCell.SpecialCells(xlLastCell)
> > *wd.Range(wd.Cells(1, 1), lc).ClearContents
>
> > *pth = wa.Range("B1").Value
> > *i = 4: j = 1
> > *While Not IsEmpty(wa.Cells(i, 1))
> > * * fnm = wa.Cells(i, 1).Value
> > * * Workbooks.Open (pth & fnm)
> > * * Set wb = ActiveWorkbook
> > * * For Each tb In wb.Worksheets
> > * * * *tb.Activate
> > * * * *Set lc = ActiveCell.SpecialCells(xlLastCell)
> > * * * *If lc.Row <> 1 And lc.Column <> 1 Then
> > * * * * *wd.Cells(j, 1).Value = wb.Name
> > * * * * *wd.Cells(j, 2).Value = tb.Name
> > * * * * *j = j + 2
> > * * * * *tb.Range(tb.Cells(1, 1), lc).Copy
> > * * * * *wd.Cells(j, 3).PasteSpecial Paste:=xlPasteValues
> > * * * * *j = j + lc.Row
> > * * * *End If
> > * * Next
> > * * wb.Close
> > * * i = i + 1
> > *Wend
> > *Application.CutCopyMode = False
> > *Range("A1").Select
> > *Application.DisplayAlerts = True
> > *Application.ScreenUpdating = True
>
> > End Sub
>
> > Thanks in advance,- Hide quoted text -
>
> - Show quoted text -
Thanks,
Similar Threads
