PDA

View Full Version : [SOLVED] Update Master File With Data From Open Workbook



sharc316
04-06-2017, 06:59 PM
Hi,

I need some assistance with modifying the code below. Currenlty the code loops through workbooks andn worksheets in a folder, copies its data and appends it to the master file. I would like to modify the path code to only copy and append data to the master file from currently open workbook.

Any help would be greatly appreciated.




Option Explicit

Sub ConsolidateData()

Dim myPath As String
Dim SumPath As String
Dim MyName As String
Dim SumName As String
Dim MyTemplate As String
Dim SumTemplate As String
Dim myWS As Worksheet
Dim sumWS As Worksheet
Dim Last_Row As Long

'Define folders and filenames
myPath = "Path\"
SumPath = "master folder\"
MyTemplate = "*.xls" 'Set the template.
SumTemplate = "Master.xlsm"

'Open the master file and get the Worksheet to put the data into
SumName = Dir(SumPath & SumTemplate)
Workbooks.Open SumPath & SumName

On Error Resume Next

Set sumWS = ActiveWorkbook.Worksheets("Sheet1")
'Open each source file, copying the data from each into the template file
MyName = Dir(myPath & MyTemplate) 'Retrieve the first file
Do While MyName <> ""
'Open the source file and get the worksheet with the data we want.
Workbooks.Open myPath & MyName
Set myWS = ActiveWorkbook.Worksheets("Sheet1")
'Copy the data from the source and paste at the end of Summary sheet
'myWS.Range("A2:Z100").Copy

'Selects data until last row and copies it
With myWS.Range("A2")
Range(.Cells(1, 1), .End(xlDown).Cells(1, 21)).Copy
End With

sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ActiveCell.Copy 'Suppresses the clipboard data prompt; since it only appears when large data set is copied
'Close the current sourcefile and get the next
Workbooks(MyName).Close SaveChanges:=False 'close
MyName = Dir 'Get next file
Loop

Set sumWS = ActiveWorkbook.Worksheets("Sheet2")
'Open each source file, copying the data from each into the template file
MyName = Dir(myPath & MyTemplate) 'Retrieve the first file
Do While MyName <> ""
'Open the source file and get the worksheet with the data we want.
Workbooks.Open myPath & MyName
Set myWS = ActiveWorkbook.Worksheets("Sheet2")

'Selects data until last row and copies it
With myWS.Range("A2")
Range(.Cells(1, 1), .End(xlDown).Cells(1, 21)).Copy
End With

sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ActiveCell.Copy 'Suppresses the clipboard data prompt; since it only appears when large data set is copied
'Close the current sourcefile and get the next
Workbooks(MyName).Close SaveChanges:=False 'close
MyName = Dir 'Get next file
Loop

End Sub

mdmackillop
04-07-2017, 01:58 AM
This will provide the name of open workbooks. It will need further refining if you have other books open.

Dim w As Workbook
For Each w In Workbooks
If w.Name <> ThisWorkbook.Name And w.Name <> "PERSONAL.XLSB" Then
MsgBox w.Name
End If
Next

sharc316
04-07-2017, 07:21 PM
Hi mdmackillop,

What I'm actually doing is clicking a button from a setup/master file and appending a new data file to the master file. The code I've pasted above loops through all the files and worksheets within a folder and updates the master file. I would like to append the master from only one specific file so that I dont have to run through all the workbooks every time a new file comes out.

So I would like above code to execute on the current file that is open but not the master workbook where I'm clicking the button from to run the macro. I'm thinking this code needs to be modified to change the path:


'Define folders and filenames
myPath = "Path\"
SumPath = "master folder\"
MyTemplate = "*.xls" 'Set the template.
SumTemplate = "Master.xlsm"

mdmackillop
04-08-2017, 02:38 AM
The code I provided should give you that workbook name; Set MyTemplate to w.name

sharc316
04-08-2017, 07:11 AM
So I'm running the macro with the code below; but nothing happens and it does not update the master file with the currently open workbook data. (Sorry if the code isnt showing right. Not sure why it's not displaying property; tried multiple times.) But i've just combined the code you provided with the code I've shared in the original post.



Option Explicit

Sub ConsolidateData()

Dim myPath As String
Dim SumPath As String
Dim MyName As String
Dim SumName As String
Dim MyTemplate As String
Dim SumTemplate As String
Dim myWS As Worksheet
Dim sumWS As Worksheet
Dim Last_Row As Long


Dim w As Workbook
For Each w In Workbooks
If w.Name <> ThisWorkbook.Name And w.Name <> "PERSONAL.XLSB" Then
MsgBox w.Name
End If
Next

'Define folders and filenames SumPath = "master folder\" MyTemplate = "*.xls" 'Set the template. SumTemplate = "Master.xlsm" 'Open the master file and get the Worksheet to put the data into SumName = Dir(SumPath & SumTemplate) Workbooks.Open SumPath & SumName On Error Resume Next Set sumWS = ActiveWorkbook.Worksheets("Sheet1") 'Open each source file, copying the data from each into the template file MyName = Dir(myPath & MyTemplate) 'Retrieve the first file Do While MyName <> "" 'Open the source file and get the worksheet with the data we want. Workbooks.Open myPath & MyName Set myWS = ActiveWorkbook.Worksheets("Sheet1") 'Copy the data from the source and paste at the end of Summary sheet 'myWS.Range("A2:Z100").Copy 'Selects data until last row and copies it With myWS.Range("A2") Range(.Cells(1, 1), .End(xlDown).Cells(1, 21)).Copy End With sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues ActiveCell.Copy 'Suppresses the clipboard data prompt; since it only appears when large data set is copied 'Close the current sourcefile and get the next Workbooks(MyName).Close SaveChanges:=False 'close MyName = Dir 'Get next file Loop Set sumWS = ActiveWorkbook.Worksheets("Sheet2") 'Open each source file, copying the data from each into the template file MyName = Dir(myPath & MyTemplate) 'Retrieve the first file Do While MyName <> "" 'Open the source file and get the worksheet with the data we want. Workbooks.Open myPath & MyName Set myWS = ActiveWorkbook.Worksheets("Sheet2") 'Selects data until last row and copies it With myWS.Range("A2") Range(.Cells(1, 1), .End(xlDown).Cells(1, 21)).Copy End With sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues ActiveCell.Copy 'Suppresses the clipboard data prompt; since it only appears when large data set is copied 'Close the current sourcefile and get the next Workbooks(MyName).Close SaveChanges:=False 'close MyName = Dir 'Get next file Loop End Sub

mdmackillop
04-09-2017, 04:50 AM
More like

'Define folders and filenames
myPath = "Path\"
SumPath = "master folder\"
SumTemplate = "Master.xlsm"


For Each w In Workbooks
If w.Name <> ThisWorkbook.Name And w.Name <> "PERSONAL.XLSB" Then
MyTemplate = w.Name 'Set the template
End If
Next

sharc316
04-21-2017, 05:01 PM
Can't seem to make this work. Perhaps a different approach would be beneficial. Instead of specifying the path for the file can the code below be modified to to run on an open workbook/active workbook. (master file will be open too as the data from the active workbook will be appended to it).

Any help would be greatly appreciated.


Option Explicit

Sub ConsolidateData()

Dim myPath As String
Dim SumPath As String
Dim MyName As String
Dim SumName As String
Dim MyTemplate As String
Dim SumTemplate As String
Dim myWS As Worksheet
Dim sumWS As Worksheet
Dim Last_Row As Long

'Define folders and filenames
myPath = "Path\"
SumPath = "master folder\"
MyTemplate = "*.xls" 'Set the template.
SumTemplate = "Master.xlsm"

'Open the master file and get the Worksheet to put the data into
SumName = Dir(SumPath & SumTemplate)
Workbooks.Open SumPath & SumName

On Error Resume Next

Set sumWS = ActiveWorkbook.Worksheets("Sheet1")
'Open each source file, copying the data from each into the template file
MyName = Dir(myPath & MyTemplate) 'Retrieve the first file
Do While MyName <> ""
'Open the source file and get the worksheet with the data we want.
Workbooks.Open myPath & MyName
Set myWS = ActiveWorkbook.Worksheets("Sheet1")
'Copy the data from the source and paste at the end of Summary sheet
'myWS.Range("A2:Z100").Copy

'Selects data until last row and copies it
With myWS.Range("A2")
Range(.Cells(1, 1), .End(xlDown).Cells(1, 21)).Copy
End With

sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ActiveCell.Copy 'Suppresses the clipboard data prompt; since it only appears when large data set is copied
'Close the current sourcefile and get the next
Workbooks(MyName).Close SaveChanges:=False 'close
MyName = Dir 'Get next file
Loop

Set sumWS = ActiveWorkbook.Worksheets("Sheet2")
'Open each source file, copying the data from each into the template file
MyName = Dir(myPath & MyTemplate) 'Retrieve the first file
Do While MyName <> ""
'Open the source file and get the worksheet with the data we want.
Workbooks.Open myPath & MyName
Set myWS = ActiveWorkbook.Worksheets("Sheet2")

'Selects data until last row and copies it
With myWS.Range("A2")
Range(.Cells(1, 1), .End(xlDown).Cells(1, 21)).Copy
End With

sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ActiveCell.Copy 'Suppresses the clipboard data prompt; since it only appears when large data set is copied
'Close the current sourcefile and get the next
Workbooks(MyName).Close SaveChanges:=False 'close
MyName = Dir 'Get next file
Loop

End Sub

mdmackillop
04-23-2017, 03:47 AM
Option Explicit

Sub ConsolidateData()

Dim myPath As String
Dim SumPath As String
Dim MyName As String
Dim SumName As String
Dim MyTemplate As String
Dim SumTemplate As String
Dim myWS As Worksheet
Dim sumWS As Worksheet
Dim Last_Row As Long
Dim Master As Workbook
Dim Arr, a

'Define folders and filenames
myPath = "C:\VBAX\Path\" 'Path to data files
SumPath = "C:\VBAX\master folder\"
MyTemplate = "*.xls" 'Set the template.
SumTemplate = "Master.xlsm"

Arr = Array("Sheet1", "Sheet2")

'Open the master file and get the Worksheet to put the data into
Set Master = Workbooks.Open(SumPath & SumTemplate)

On Error Resume Next
For Each a In Arr
Set sumWS = Master.Worksheets(a)
'Open each source file, copying the data from each into the template file
MyName = Dir(myPath & MyTemplate) 'Retrieve the first file
Do While MyName <> ""
'Open the source file and get the worksheet with the data we want.
Workbooks.Open myPath & MyName
Set myWS = ActiveWorkbook.Worksheets(a)
'Copy the data from the source and paste at the end of Summary sheet
'Selects data until last row and copies it
With myWS.Range("A2")
Range(.Cells(1, 1), .End(xlDown).Cells(1, 21)).Copy
End With

sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False 'Suppresses the clipboard data prompt; since it only appears when large data set is copied
'Close the current sourcefile and get the next
Workbooks(MyName).Close SaveChanges:=False 'close
Application.Goto sumWS.Range("A2")
MyName = Dir 'Get next file
Loop
Next a
End Sub

sharc316
04-26-2017, 05:59 PM
Thanks mdmackillop. I've tried your solution but it seems that it still tries to run through files in a folder. I only want the currently open file appended to the master. I also get repeated messages that the file is already open.

jolivanes
04-27-2017, 09:49 PM
Maybe I am thinking too simple.
If you have a Master Workbook, it should be in a static Folder isn't it?


If it is closed

Sub Maybe()
Dim lr As Long, lc As Long, wb1 As Workbook, sh1 As Worksheet, a
Set wb1 = ThisWorkbook
Set sh1 = wb1.Sheets("Sheet1")
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
a = Range(Cells(1, 1), Cells(lr, lc)).Value


With Workbooks.Open("C:\Folder where Master resides\Masterbook.xlsm").Sheets("Sheet1")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lr, lc).Value = a
ActiveWorkbook.Close True
End With


End Sub


If it is open but not active

Sub Maybe_2()
Dim lr As Long, lc As Long, wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, a
Set wb1 = ThisWorkbook
Set wb2 = Workbooks("Masterbook.xlsm")
Set sh1 = wb1.Sheets("Sheet1")
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
a = Range(Cells(1, 1), Cells(lr, lc)).Value


With wb2.Sheets("Sheet1")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lr, lc).Value = a
End With


End Sub

sharc316
04-29-2017, 06:16 PM
Hi Jolivanes,

Thank you for your reply. The master will be in a static folder and I can provide a file path for it. But does your code update only sheet1?

I have multiple sheets within the master and within each file that comes out weekly. I would need each sheet to be matched by sheet name to the master and then append it with the new data.

Any help would be greatly appreciated. I've been struggling with getting this to work.

jolivanes
04-29-2017, 07:01 PM
Sorry about that.
I must have missed where you asked to update multiple sheets in the Master from the weekly multiple sheets/files.
Might have time later tomorrow to look into it.

mdmackillop
04-30-2017, 02:59 AM
Option Explicit
Sub ConsolidateData()

Dim myWS As Worksheet
Dim sumWS As Worksheet
Dim w As Workbook
Dim Master As Workbook
Dim Source As Workbook
Dim Arr, a
Dim Chk

Arr = Array("Sheet1", "Sheet2")

Set Master = Workbooks("Master.xlsm")
For Each w In Workbooks
If w.Name <> Master.Name And w.Name <> "PERSONAL.XLSB" Then
Set Source = w 'Set the Source
Exit For
End If
Next

'Check the source
If Source Is Nothing Then Exit Sub
Chk = MsgBox("Source workbook = " & Source.Name & vbCr & " Continue?", vbQuestion + vbYesNo)
If Chk = vbNo Then Exit Sub

On Error Resume Next
For Each a In Arr
Set sumWS = Master.Worksheets(a)
Set myWS = Source.Worksheets(a)
'Copy the data from the source and paste at the end of Summary sheet
'Selects data until last row and copies it
With myWS.Range("A2")
Range(.Cells(1, 1), .End(xlDown).Cells(1, 21)).Copy
End With

sumWS.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.Goto sumWS.Range("A2")
Next a
Source.Close SaveChanges:=False 'close
End Sub

sharc316
05-01-2017, 08:51 AM
Thank you mdmackillop. This worked pretty well.

Just have one issue; the master file has all the worksheets that are found in statement files, but sometimes the statement workbook does not have a worksheet if there is no data for that particular category in that time frame. For example; bonus, if there is no bonus in March, then the bonus worksheet will not appear in that particular statement file.

What happens currently is that it takes the data from the previous worksheet in statement file and appends it to the master file in worksheet that does not exist in the statement file.

So would need something that checks for the worksheet name, if it does not exist then move on.

Thank you for your time and help.

mdmackillop
05-01-2017, 09:00 AM
Use a loop to populate the array with sheet names from the Source workbook.

sharc316
05-01-2017, 02:11 PM
I wasn't able to make the loop work. Ended up creating worksheets, if they did not exist, within each statement workbook so now they are all consistent. These will be blank so no data will be pulled but master will be appended correctly now.

mdmackillop
05-01-2017, 02:30 PM
Option Explicit

Sub ConsolidateData()

Dim myWS As Worksheet
Dim sumWS As Worksheet
Dim w As Workbook
Dim Master As Workbook
Dim Source As Workbook
Dim Chk


Set Master = Workbooks("Master.xlsm")
For Each w In Workbooks
If w.Name <> Master.Name And w.Name <> "PERSONAL.XLSB" Then
Set Source = w 'Set the Source
Exit For
End If
Next

'Check the source
If Source Is Nothing Then Exit Sub
Chk = MsgBox("Source workbook = " & Source.Name & vbCr & " Continue?", vbQuestion + vbYesNo)
If Chk = vbNo Then Exit Sub

On Error Resume Next
For Each myWS In Source.Worksheets
Set sumWS = Master.Worksheets(myWS.Name)

'Copy the data from the source and paste at the end of Summary sheet
'Selects data until last row and copies it
With myWS.Range("A2")
Range(.Cells(1, 1), .End(xlDown).Cells(1, 21)).Copy
End With

sumWS.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.Goto sumWS.Range("A2")
Next myWS
Source.Close SaveChanges:=False 'close
End Sub

sharc316
05-01-2017, 06:17 PM
This works great.

I'm trying to omit "sheet1" from the loop. Dont need to append it, I've tried If myWS.Name <> "sheet1" Then, but no luck. Particularly getting errors with Next myWS at the bottom not having a For. Tried different way but can't seem to be able to work this in.

mdmackillop
05-02-2017, 01:47 AM
For Each myWS In Source.Worksheets
If myWS.name <> "Sheet1" then
Set sumWS = Master.Worksheets(myWS.Name)

'Copy the data from the source and paste at the end of Summary sheet
'Selects data until last row and copies it
With myWS.Range("A2")
Range(.Cells(1, 1), .End(xlDown).Cells(1, 21)).Copy
End With

sumWS.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.Goto sumWS.Range("A2")
End If
Next myWS

sharc316
05-03-2017, 10:52 AM
Ahh I was so close! This works great.

Thank you mdmackillop for all of your help and patience. Really appreciate your time. You Rock!!!