PDA

View Full Version : VBA Combining Data from Multiple Workbook into One - Need help ASAP



paazan
03-08-2018, 05:37 PM
What I’m trying to do:
I have multiple sheets store in a folder, let’s say the path is “C:\desk\reports”. The number of Excel files will keep growing, and they are of the same setting including the number of sheets and types of information being stored.
What I want to do is combine the information in the same sheets existing in each and every one of these workbooks, let’s say the sheets are called “Data_Source”, into another workbook, which I store in another place. Let’s called it “Master Workbook”. Specifically, the data will be combined and put into a sheet called “Combined_data” in the Master Workbook.l Both of the data source sheet and the “Combined_data” sheet has the same headers so no need to copy but simply keep adding more rows.
The VBA will be run in the Master Workbook so that I don’t have to open each one of the data source workbooks when consolidating them.

Challenges:
1, Data source workbooks are protected workbooks, set up in the Review – Protect Workbook.
2, Data source is, again, stored in the same sheet called “sheet2” in every workbook, and are hidden
3, The data source in Data_Source sheets is liked and reading from other sheets in the same workbook.

Now, the code that I have is a loop going into that folder and open every one of them one by one, and copy past the cells over. But my code would copy the entire range with formula and formatting altogether. This causes two problems: 1, the rows empty but with formulas would be copied over as well, which will mislead the next loop in determining where’s the next empty row to start pasting 2, the copied formula tend to read from incorrect places.
Therefore, I only want values to be copied and pasted.

Please help to solve this. Any other suggestions to simplified the procedure would be greatly appreciated.

Thanks a lot!


21777

werafa
03-09-2018, 02:30 PM
you can open workbooks and read protected data
you can read hidden sheets
you can append table data provided table structure is the same

1: you need to manage file name, location and load status
2: you need to open new source data wbs and copy out the data
3: you need to append data to the master table
4: you need to manage any probable errors
5: you might need to manage delete and reload of data

this will let you manage file name and location


Sub GetFilePath(myRow As Long)'Return file name and path to worksheet cells


Dim myObject As Object
Dim fileSelected As String
Dim myPath As String
Dim myFile As String
Dim strLen As Integer


Set myObject = Application.FileDialog(msoFileDialogOpen)

With myObject
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub
fileSelected = .SelectedItems(1)
End With

strLen = Len(fileSelected) - InStrRev(fileSelected, "\")
myFile = Right(fileSelected, strLen)
strLen = Len(fileSelected) - strLen - 1
myPath = Left(fileSelected, strLen)

With Worksheets("Admin")
.Range("G" & myRow) = myPath 'The file path
.Range("F" & myRow) = myFile 'The file name
.Range("C" & myRow, "D" & myRow).Font.Color = vbBlack
If Len(myFile) > 0 Then
.Range("D" & myRow).Value = "File Located"
Else
.Range("D" & myRow).Value = "No File"
End If
End With
End Sub



and


If fileArray(myMonth, 2) <> "Loaded" And fileArray(myMonth, 1) = "File Located" Then 'load data
fileName = fileArray(myMonth, 3)
myPath = fileArray(myMonth, 4)
myString = myPath & "/" & fileName

If BookOpen(fileName) = True Then Workbooks(fileName).Close SaveChanges:=True

If Dir(myString) <> "" Then 'workbook name exists at location
Set dataWB = Workbooks.Open(fileName:=myString)
Else
myWB.Worksheets("Admin").Cells(myMonth + 6, 4).Value = "File Missing"
End If

DoEvents 'ensure file opens fully before continuing

do some stuff

Workbooks(fileName).Close SaveChanges:=True 'error correction can edit source data
DoEvents

do some more stuff


you can use an array or a range to pass the data to the source workbook. be careful with writing large tables - loops that call the sheet/range object for each cell are slow, and you can transfer a range quickly with range.copy destination:=myDestRange type logic

werafa
03-09-2018, 02:34 PM
Private Function BookOpen(strBookName As String) As Boolean'test whether worbook is already open
Dim oBk As Workbook
On Error Resume Next
Set oBk = Workbooks(strBookName)
On Error GoTo 0
If oBk Is Nothing Then
BookOpen = False
Else
BookOpen = True
End If
End Function