L
Loop
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,
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,