Copy data from one workbook to an existing workbook in folder

[msquared99]

OK, Excel VBA gurus, I am trying to take data from a workbook and for each sales rep it find and copy that data into an already existing workbook in the folder.

Example:
Workbook (Raw Data Workbook) with VBA Module
Column1 Column2 Column3
Sam ABC Inc $2500
Bill EFG Co $1500
Bill HIJ Inc $900
Bill Acme, Inc $3000
Jack XYZ LLC $4000
Jack GHI, Inc $1000

Existing workbooks (Target Workbooks) in the folder would be:
Sam 02-15.xlsx
Bill 02-15.xlsx
Jack 02-15.xlsx

For each instance of Sam it would copy the data from the Raw Data Workbook into the workbook Sam 02-15.xlsx and so on. The 02-15 would change each month. The Raw Data Workbook would be saved in the folder containing the target workbooks. Even better would be able to select the folder containing the Target Workbooks from the Raw Data Workbook.

Any ideas would be greatly appreciated.

Thanks,
Mike

 

[dianacris]

I actually just finished something similar, but I was copying out to a new workbook for each rep. Here's some of the code I used to make that work. With some manipulation, you can have it locate the file. Hopefully you have the date portion that would be different each month located somewhere in your spreadsheet so that the code knows what to look for.

First, convert the data to a table so that you can filter it easily.

Sub AgingTableWithHeaders()
  Dim rTable As Range
  Dim lHeadersRows As Long
  
  'get current region which includes row 1
  Range("A2").CurrentRegion.Select
  Set rTable = Selection
  
  'Resize the range minus lHeadersRows rows
  Set rTable = rTable.Resize(rTable.Rows.Count - 1)
  
  'Move new range down to Start at the first data row.
  Set rTable = rTable.Offset(1)
  sTableName = "AgingTable" & Format(Date, "md")
  ActiveSheet.ListObjects.Add(xlSrcRange, rTable, , xlYes).Name = sTableName
End Sub

Next, sort it.

Sub SortTableByProducer()
  ActiveWorkbook.Sheets(ActiveSheet.Name).ListObjects(1).Sort.SortFields.Clear
  ActiveWorkbook.Sheets(ActiveSheet.Name).ListObjects(1).Sort.SortFields.Add _
  Key:=Range(sTableName & "[[#All],[Producer]]"), SortOn:=xlSortOnValues, _
  Order:=xlAscending, DataOption:=xlSortTextAsNumbers
  With ActiveWorkbook.Worksheets(ActiveSheet.Name).ListObjects(1).Sort
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
End Sub

Next, filter and copy the data.

Function FilterAndCopy(ByVal sProducer As String, ByVal sPath As String, ByVal sAging As String) As String
    Dim wbNew As Workbook
    Dim sFile As String
  
    'filter and copy producer data
    ActiveSheet.ListObjects(sTableName).Range.AutoFilter Field:=1, _
        Criteria1:=sProducer
    Range(sTableName & "[[#Headers],[Producer]]").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
  
    If Selection.Rows.Count = 0 Then Exit Function
    Selection.Copy
  
    'create new workbook and paste data
    Workbooks.Add
    Set wbNew = ActiveWorkbook
    wbNew.Worksheets(1).Range("A1").Select
    Selection.PasteSpecial xlPasteValues
    Selection.PasteSpecial xlPasteFormats
    ActiveWindow.SelectedSheets(1).Cells.EntireColumn.AutoFit
  
    'save new file in specified location and then close it
    sFile = sPath & "\" & sProducer & "-" & sAging & ".xlsx"
    wbNew.SaveAs Filename:=sFile, FileFormat:=51, CreateBackup:=False
    wbNew.Close
  
    FilterAndCopy = sFile
  
    Set wbNew = Nothing
End Function

In the FilterAndCopy you'll need to change the code to OPEN a workbook rather than ADD a new workbook.

I had a master macro that called the filter function in a loop so that I generated a file for each producer. I have my list of producers in an Access table so I connected to it and then used a recordset to loop thru each record.

Hope this gets you started!

 

[msquared99]

OK, I have the code to loop through the files in the folder. I am struggling with the code to match the data from the source workbook into the existing workbook by name only.

Sub LoopThroughFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim VariableFN As String
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xlsx"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'**************************************************************
Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "IC"
Sheets("IC").Move After:=Sheets(2)
'***************************************************************
'***************************************************************
'Here is where I am lost. I want to take data from a spreadsheet C:\Inter Company.xlsx
'have it match the name in column N to the found spreadsheet and copy all the matching data
'from Inter Company.xlsx into the existing file Sam MM-DD.xlsx. So, in Inter Company.xlsx if Sam is found, all that data will be copied
'into the matching spreadsheet which would be named Sam MM-DD.xlsx. I am only looking to
'match the name and not the MM-DD
'Save and Close Workbook
wb.Close SaveChanges:=True
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[msquared99]

OK, I solved this. Diana your code helped. Thanks!