Excel macro

[Matthew S.]

So I have a little project for work that I've been trying to get my head around all weekend.

 

We have a master file for the associate headcount in the facility that we want to pull information in from the individual departments, I know I could do it with a Linked cell but we want to keep a history will clearing each departments file after pull the information we require.

 

Basically each departments file will have 2 columns, one for Full Time workers and one for Temps.  The master file that pulls all this in will have the information provided by HR that each department is supposed to have and the variances from what is submitted by the various departments.  (We don't want a submit button cause we've found in the past that they corrupt files easily)

[Haggis Veteran]

can you provide an example copy to work with?

[Matthew S.]

I'll give an example of both haggis.

 

Here's the department file https://dl.dropboxusercontent.com/u/115621/hc-dept1.xlsx

Here's the master https://dl.dropboxusercontent.com/u/115621/hc-master.xlsx

 

I've found a macro online that does half of what I want to do but it wont paste into the mast sheet thats already formatted... :/ it'll only start the paste in the A column >.<

Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook
Public strCopyRange As String

Sub GetData()
    Dim strWhereToCopy As String, strStartCellColName As String
    Dim strListSheet As String
    
    strListSheet = "List"
    
    On Error GoTo ErrH
    Sheets(strListSheet).Select
    Range("B2").Select
    
    'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
    Set currentWB = ActiveWorkbook
    Do While ActiveCell.Value <> ""
        
        strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
        strCopyRange = ActiveCell.Offset(0, 2) & ":" & ActiveCell.Offset(0, 3)
        strWhereToCopy = ActiveCell.Offset(0, 4).Value
        strStartCellColName = Mid(ActiveCell.Offset(0, 5), 2, 1)
        
        Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
        Set dataWB = ActiveWorkbook
        
        Range(strCopyRange).Select
        Selection.Copy
        
        currentWB.Activate
        Sheets(strWhereToCopy).Select
        lastRow = LastRowInOneColumn(strStartCellColName)
        Cells(lastRow + 1, 1).Select
        
        Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Application.CutCopyMode = False
        dataWB.Close False
        Sheets(strListSheet).Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Exit Sub
    
ErrH:
    MsgBox "It seems some file was missing. The data copy operation is not complete."
    Exit Sub
End Sub

Public Function LastRowInOneColumn(col)
    'Find the last used row in a Column: column A in this example
    'http://www.rondebruin.nl/last.htm
    Dim lastRow As Long
    With ActiveSheet
    lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
    End With
    LastRowInOneColumn = lastRow
End Function

Edited January 27, 2014 by DJ Dark