Automating transfer of data in cells

  • Thread starter Thread starter Earl Grey
  • Start date Start date
E

Earl Grey

I have a time management spreadsheet with data stored
against work type and date. I need to transfer this data
into a similar but more comprehensive spreadsheet and
wonder whether it is possible to automate this task by
using the work types and dates in a macro (I have almost
10 months of data to transfer), along the lines of check
date, check worktype, where argument is true enter data
from cell. I think I need to use visual basic, but I
can't find out how in the help screens.

Any advice is much appreciated.
 
This is not difficult providing you keep your data in simple tables and
put them all into a single master. No need for formatting or anything
else because you can then use the more powerful features of Excel such
as Pivot tables and Database Formulas to do analyses.

Here is a suitable base macro that you might find helpful. It would be
fairly straightforward to filter the data a bit before transfer, but,
in my opinion, a waste of time. It is usually easier to do all this in
the final table - or simply omit it from your calculations.

'===============================================
'- Generic code for transferring data from
'- one or more workbooks to a master sheet
'-
'- workbooks must be the only ones in the folder
'- worksheets must be the first one in the book
'- worksheets must be contain tables which are
'- identical to the master, headings in row 1.
'- master sheet is remade each time.
'- run this code from the master book
'-
'----------------------------------------------
Dim ToBook As String
Dim ToSheet As Worksheet
Dim NumColumns As Integer
Dim ToRow As Long
Dim FromBook As String
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim LastRow As Long
'-
'----------------
Sub NEW_MASTER()
'----------------
Application.Calculation = xlCalculationManual
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
ToBook = ActiveWorkbook.Name
Set ToSheet = ActiveWorkbook.Worksheets(1)
NumColumns = ToSheet.Range("A1").End(xlToRight).Column
ToRow = ToSheet.Range("A65536").End(xlUp).Row
'- clear master
If ToRow <> 1 Then
ToSheet.Range(Cells(2, 1), Cells(ToRow,
NumColumns)).ClearContents
End If
ToRow = 2
'- main loop
FromBook = Dir("*.xls")
While FromBook <> ""
If FromBook <> ToBook Then
Application.StatusBar = FromBook
Transfer_data
End If
FromBook = Dir
Wend
'-- close
MsgBox ("Done.")
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
End Sub
'-------------------------------------------------

Sub Transfer_data()
Workbooks.Open FileName:=FromBook
Set FromSheet = Workbooks(FromBook).Worksheets(1)
LastRow = FromSheet.Range("A65536").End(xlUp).Row
FromSheet.Range(Cells(2, 1), Cells(LastRow, NumColumns)).Copy _
Destination:=ToSheet.Range("A" & ToRow)
ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
Workbooks(FromBook).Close savechanges:=False
End Sub
'==== EOP ======================================
 
Back
Top