Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Hi -
I need to 'consolidate' data into one Master Workbook -- my current code is below. The data currently sits in approx 30 workbooks and is spread across a number of worksheets within each WB. All WB are set up exactly the same way -- same sheet names, etc. The Master WB also has the same Sheet names (to keep things simple). My code worked fine when just hitting one worksheet within each WB. However, when I modified the code to pull from all of the sheets, it didn't work at all! My modification was to activate the vArr code and change all references to the single worksheet to use the 'ws' reference. When I run the code now, the first WB opens and then the code stops. What's causing this and how do I fix it? A couple of other small things aren't working -- there's code to isolate the store number from the name of each target WB and insert it into Column A. It should put this store number next to EACH ROW that is transferred, but it currently just puts it in the first row. When all data has been pulled from the target WBs, I want all blank rows to be deleted from each data tab in the Master WB. A blank row is any row where cells Ax & Bx (where x is row #) are blank. Any help is greatly appreciated ... here's my current code: Sub Example2() Dim MyPath, getstore As String Dim FilesInPath As String Dim MyFiles() As String Dim SourceRcount, x As Long Dim Fnum, i As Long Dim mybook As Workbook Dim basebook As Workbook Dim sourceRange As Range Dim destrange As Range Dim rnum As Long Dim ws As Worksheet MyPath =" \\server\folder1\folder2\folder3\" ' the following are sheets within each target WB vArr = Array("Sales Act", "Hours Act", "Sales LY", "Sales Goal", "Hours LY", "Hours Goal", "Sales Forecast", "Hours Forecast") 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no Excel files in the folder exit the sub FilesInPath = Dir(MyPath & "*.xls") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If On Error GoTo CleanUp Application.EnableEvents = False Application.DisplayAlerts = False Application.ScreenUpdating = False Set basebook = ThisWorkbook 'clear all cells on the first sheet basebook.Worksheets("Hours Act").Cells.Clear rnum = 2 'Fill the array(myFiles)with the list of Excel files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Loop through all files in the array(myFiles) and selected sheets in array(vArr) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum)) For i = LBound(vArr) To UBound(vArr) Set sh = Worksheets(vArr(i)) Set sourceRange = mybook.sh.UsedRange SourceRcount = sourceRange.Rows.Count Set destrange = basebook.sh.Range("B" & rnum) ' Isolates the store number from the workbook name getstore = Replace(mybook.Name, "Weekly report sales & hours_", "") getstore = Replace(getstore, ".xls", "") basebook.sh.Cells(rnum, "A").Value = getstore With sourceRange Set destrange = basebook.sh.Cells(rnum, "B").Resize(.Rows.Count, .Columns.Count) End With destrange.Value = sourceRange.Value Next rnum = rnum + SourceRcount mybook.Close savechanges:=False Next Fnum End If CleanUp: Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
split post code (zip code) out of cell that includes full address | Excel Discussion (Misc queries) | |||
Prompt for Korean proofread | Excel Discussion (Misc queries) | |||
Shorten code to apply to all sheets except a few, instead of individually naming them, and later adding to code. | Excel Programming | |||
Protect Sheet with code, but then code will not Paste error. How do i get around this. Please read for explainations.... | Excel Programming | |||
Excel code convert to Access code - Concat & eliminate duplicates | Excel Programming |