Solved: Export/Import data to multiple workbooks?

[slang]

Because I have a limited amount of programing experience I got myself into a corner where I have to do something really ugly but I am on a timeline.

I have built an application on 36 users laptops that capture data and save it to a workbook with one sheet(sheet1) as data and name the range "data" Each users datafile is #activity.xls (from 1 to 36) These workbooks are copied to the share from the app when they update.

What I need to do now (i know, its UGLY!) is write a macro that will open all these workbooks in sequence, copy the "Data" back to a master sheet that makes one large database.

I have been experimenting with pieces of code from similar projects but its just not going well.:banghead:

Any help from the Excel gods :bow: would be appreciated since I am trying to go on vacation on Friday:help

[MikeO]

Start with this. It will open the excel files one at a time:

Dim ThisBook As Workbook
Dim ThisFileName As String
Dim ThisPathName As String
Dim I As Integer
ThisPathName = "C:/data" '<--Replace the directory the files are under
ChDrive ThisPathName
ChDir ThisPathName
For I = 1 To 36
ThisFileName = Dir(I & "activity.xls")
Set ThisBook = Workbooks.Open(ThisFileName)

''''write code to copy data here.

ThisBook.Close False

Next I

[Simon Lloyd]

You will not be able to read of each laptops C drive, the workbooks need to be stored on a network drive, also you will not be able defeat any passwords that have been set!

[slang]

OK I have the code working but is there any way of shortening it up so it will run faster?
I know, I suck at coding but am starting to learn a bit.


Sub updatedata()
Dim activityworkbook As String
Dim file As String
Dim datarange As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("activity").Select
Application.DisplayAlerts = False
For x = 1 To 36
Range("a2").Select
activityworkbook = "I:\BDMSFA\BDMdatafiles\" & x & "activity.xls"
Workbooks.Open Filename:=activityworkbook
If Range("a2") = "" Then
ActiveWindow.Close
Else
Workbooks.Open Filename:=activityworkbook
Range("A2").Select
Range(Range("a2"), ActiveCell.SpecialCells(xlLastCell)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.Close
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
End If
Next x
ActiveWorkbook.Names("data").Delete
Range("a1").Select
Range(Range("a1"), ActiveCell.SpecialCells(xlLastCell)).Select
ActiveCell.CurrentRegion.Name = ("data")
Sheets("profiles").Select
Application.DisplayAlerts = False
For x = 1 To 36
Range("a2").Select
activityworkbook = "I:\BDMSFA\BDMdatafiles\" & x & "profiles.xls"
Workbooks.Open Filename:=activityworkbook
If Range("a2") = "" Then
ActiveWindow.Close
Else
Range("A2").Select
Range(Range("a2"), ActiveCell.SpecialCells(xlLastCell)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.Close
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
End If
Next x
ActiveWorkbook.Names("profiledata").Delete
Range("a1").Select
Range(Range("a1"), ActiveCell.SpecialCells(xlLastCell)).Select
ActiveCell.CurrentRegion.Name = ("profiledata")
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

[mdmackillop]

Try this

Option Explicit

Sub updatedata()
Dim Test As Variant
Dim WB As Workbook
Dim WS As Worksheet
Dim Fil As String
Dim Pth As String
Dim x As Long
Dim Arr, a
Dim Tgt As Range

Application.ScreenUpdating = False
Pth = "I:\BDMSFA\BDMdatafiles\"
Arr = Array("activity", "profiles")
For Each a In Arr
Fil = a & ".xls"
Set WS = Sheets(a)

For x = 1 To 36
Set Tgt = WS.Cells(Rows.Count, 1).End(xlUp).Offset(1)
Test = GetData(Pth, x & Fil, "Sheet1", "A2")
If Test <> "" Then
Set WB = Workbooks.Open(FileName:=Pth & x & Fil)
WB.Sheets(1).UsedRange.Copy Tgt
WB.Close False
End If
Next x
Next a
ActiveWorkbook.Names("data").Delete
ActiveWorkbook.Sheets("profiles").UsedRange.Name = "data"
Application.ScreenUpdating = True
End Sub

'Get data from closed file
Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function