I have 4 workbooks which each contain a sales log. 1 is a Master Log and 3 are maintained by separate users. I am looking for the easiest way to update the Master Log with the data from the other 3 workbooks that is fast, user friendly and avoids data being corrupted by the users.
Process:-
On running Macro open alert with information - ok / cancel
Go to "Sales Log" unprotect sheet, show all, clear all filters, sort Range ("B3:B100") ascending
Open Sales Person 1 Workbook, go to 'Sales Log", unprotect sheet
Select "Range1" sort by ("B3:B100") Copy "Range1"
Paste Range1 data (values only) in Master Log Range1
SaveAs Sales Person 1 [date and time] .xlsm and Close [no alerts]
Repeat for Sales Person 2 and 3 Workbook
Master Log: Select "RangeALL" sort by ("H3:H100")
SaveAs Master Log [date and time] .xlsm and Close [no alerts] Attributes: Read Only
Close excel application
Option Explicit
Dim Master As Workbook
Dim sourceBook As Workbook
Dim sourceData As Worksheet
Dim CurrentFileName As String
Dim myPath As String
Dim frow As Long
Dim lrow As Long
Private Sub update_master()
'
'Open an Alert that I can display information with OK or Cancel.
'Prepare This Workbook: On macro start, unprotect sheet, sort Range ("B3:B100") ascending
'The folder containing the files to be recap'd
myPath = "C:\Test"
'Finds the name of the first file of type .xlsm in the current directory
CurrentFileName = Dir(myPath & "\*.xlsm")
'Create a workbook for the recap report
Set Master = ThisWorkbook
'With each file: On open, unprotect sheet, sort Range ("B3:B100") ascending before copying range
Do
Workbooks.Open (myPath & "\" & CurrentFileName)
Set sourceBook = Workbooks(CurrentFileName)
Set sourceData = sourceBook.Worksheets("SALES LOG")
With sourceData
If Left(CurrentFileName, Len(CurrentFileName) - 5) = "Salesperson1" Then
Call PreparetoCopy
.Range("RANGE1").Copy
Master.Worksheets("SALES LOG").Range("RANGE1").PasteSpecial , Paste:=xlValues
ElseIf Left(CurrentFileName, Len(CurrentFileName) - 5) = "Salesperson2" Then
Call PreparetoCopy
.Range("RANGE2").Copy
Master.Worksheets("SALES LOG").Range("RANGE2").PasteSpecial , Paste:=xlValues
ElseIf Left(CurrentFileName, Len(CurrentFileName) - 5) = "Salesperson3" Then
Call PreparetoCopy
.Range("RANGE3").Copy
Master.Worksheets("SALES LOG").Range("RANGE3").PasteSpecial , Paste:=xlValues
End If
End With
sourceBook.Close
'Calling DIR w/o argument finds the next .xlsm file within the current directory.
CurrentFileName = Dir()
Loop While CurrentFileName <> ""
'With current workbook Select Range ("RANGE_ALL") and sort ascending by Range("H3:H100").
'Save This Workbook: File Name, Current Date and Time. Ignore Alerts. Attributes=Read Only
ThisWorkbook.Save
'Save current workbook File Name, Current Date and Time. Ignore Alerts not working.
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Test\SALES LOG1.xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:="C:\Test\SALES LOG2.xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:="C:\Test\SALES LOG3.xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ThisWorkbook.Close
'Close Excel Application.
End Sub
Bookmarks