Solved: copy cells from many .xls files to master file

[dmat619]

I am not a VBA programmer but have been assigned the task of writing a vba program. I do have some VB experience although it is old. Here is the problem:

I have a directory with many .xls files. I need to copy certain cells from all files to the master file. Here is a more specific description:

Z5,AC25-AC35 From 1st .xls file
To master file A1,A2-A12

Then from the next .xls file

To master file B1,B2-B12

Continuing untill all .xls files have these cells copied to the master file.
All files have only 1 sheet.

I have tried adapting some of the code I found on this and other forums, but without any success. Can anyone please help me while I try to complete a few tutorials.
Thanks for any help.:friends:

[geekgirlau]

Your first step in attempting something like this (and a good starting point for learning VBA) is to record a macro as you step through the process. In other words,

Start recording a macro
Open the master workbook
Open the first workbook
Copy Z5
Go to the master workbook
Paste the data into A1
Go to the first workbook
Copy AC25-AC35
Go to the master workbook
Paste the data into A2
Stop recordingThis will give you your starting point, and we can help you further from there.

[dmat619]

Thanks,
The project has become a small bit larger. At least I now know how to record a macro. One small step in the right direction. The code below works fine with one data file. I need the next files data to be moved in the same format, but starting in column C.


Sub Macro1()
'
' Macro1 Macro
' Macro recorded 6/13/2007 by dmatthewson
'
'
ChDir "C:\Documents and Settings\dmatthewson\Desktop\LVDT VBA\Test Data"
Workbooks.Open Filename:= _
"C:\Documents and Settings\dmatthewson\Desktop\LVDT VBA\Test Data\TestData1.xls"
Range("Z5").Select
Selection.Copy
Windows("TestMaster.xls").Activate
Range("B1").Select
ActiveSheet.Paste
Windows("TestData1.xls").Activate
Range("AC13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("TestMaster.xls").Activate
Range("B2").Select
ActiveSheet.Paste
Windows("TestData1.xls").Activate
Range("AC15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("TestMaster.xls").Activate
Range("B3").Select
ActiveSheet.Paste
Windows("TestData1.xls").Activate
Range("T18:T20").Select
Application.CutCopyMode = False
Selection.Copy
Windows("TestMaster.xls").Activate
Range("A4").Select
ActiveSheet.Paste
Windows("TestData1.xls").Activate
Range("AC18:AC20").Select
Application.CutCopyMode = False
Selection.Copy
Windows("TestMaster.xls").Activate
Range("B4").Select
ActiveSheet.Paste
Windows("TestData1.xls").Activate
Range("AC22").Select
Application.CutCopyMode = False
Selection.Copy
Windows("TestMaster.xls").Activate
Range("B7").Select
ActiveSheet.Paste
Windows("TestData1.xls").Activate
Range("T25:T35").Select
Application.CutCopyMode = False
Selection.Copy
Windows("TestMaster.xls").Activate
Range("A8").Select
ActiveSheet.Paste
Windows("TestData1.xls").Activate
Range("AC25:AC35").Select
Application.CutCopyMode = False
Selection.Copy
Windows("TestMaster.xls").Activate
Range("B8").Select
ActiveSheet.Paste
End Sub


Edited 15-Jun-2007 by geekgirlau. Reason: insert vba tags

[geekgirlau]

One of the things you'll find as you gain more experience is that while recording macros is an excellent starting point, there is a lot of extraneous code created. For example, when copying cells you have to select them when you're recording the macro. However you don't need to select them in vba - you can instruct your code which cell to copy and where the destination is in a single line of code.


Sub CopyToMaster()
Dim wbMaster As Workbook
Dim wb As Workbook
Dim strPath As String
Dim strFile As String
Dim lngRow As Long

On Error GoTo ErrHandler
Application.ScreenUpdating = False

' this assumes that the master workbook is active
Set wbMaster = ActiveWorkbook

strPath = "C:\Documents and Settings\dmatthewson\Desktop\LVDT VBA\Test Data\"
strFile = Dir(strPath & "*.xls", vbNormal)

' loop through all files in the folder
Do Until strFile = ""
' if the master is in the same folder, make sure it's excluded
If strFile <> "TestMaster.xls" Then
' find last row in column B
lngRow = wbMaster.Sheets(1).Cells(Cells.Rows.Count, 2).End(xlUp).Row + 1

Workbooks.Open strPath & strFile

Set wb = ActiveWorkbook
' copy the data directly to the destination
wb.Sheets(1).Range("Z5").Copy wbMaster.Sheets(1).Range("B" & lngRow)
wb.Sheets(1).Range("AC13").Copy wbMaster.Sheets(1).Range("B" & lngRow + 1)
wb.Sheets(1).Range("AC15").Copy wbMaster.Sheets(1).Range("B" & lngRow + 2)
wb.Sheets(1).Range("T18:T20").Copy wbMaster.Sheets(1).Range("A" & lngRow + 3)
wb.Sheets(1).Range("AC18:AC20").Copy wbMaster.Sheets(1).Range("B" & lngRow + 3)
wb.Sheets(1).Range("AC22").Copy wbMaster.Sheets(1).Range("B" & lngRow + 6)
wb.Sheets(1).Range("T25:T35").Copy wbMaster.Sheets(1).Range("A" & lngRow + 7)
wb.Sheets(1).Range("AC25:AC35").Copy wbMaster.Sheets(1).Range("B" & lngRow + 7)

Application.CutCopyMode = False
wb.Close False
End If

' find next file
strFile = Dir()
Loop

ExitHere:
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox Err.Number & ": " & Err.Description
Resume ExitHere
End Sub


By the way, when posting code, use the VBA button to format it as I have here - select the code text then click on "VBA" (it makes it easier to read). I've taken the liberty of doing this for you in your earlier post.

[dmat619]

Thanks,
This works great. But I still have 2 problems. one of the cells, AC15 is a formula, =AC13*-1 .
The other is AC22 which holds =AO20 and AO20 is slope(AC18:AC20,Q18:Q20)
Other than those two, everything works perfect.
Thanks

[geekgirlau]

In that case you may need to do a paste value rather than paste

Sub CopyToMaster()
Dim wbMaster As Workbook
Dim wb As Workbook
Dim strPath As String
Dim strFile As String
Dim lngRow As Long

On Error GoTo ErrHandler
Application.ScreenUpdating = False

' this assumes that the master workbook is active
Set wbMaster = ActiveWorkbook

strPath = "C:\Documents and Settings\dmatthewson\Desktop\LVDT VBA\Test Data\"
strFile = Dir(strPath & "*.xls", vbNormal)

' loop through all files in the folder
Do Until strFile = ""
' if the master is in the same folder, make sure it's excluded
If strFile <> "TestMaster.xls" Then
' find last row in column B
lngRow = wbMaster.Sheets(1).Cells(Cells.Rows.Count, 2).End(xlUp).Row + 1

Workbooks.Open strPath & strFile

Set wb = ActiveWorkbook
' copy the data directly to the destination
wb.Sheets(1).Range("Z5").Copy wbMaster.Sheets(1).Range("B" & lngRow)
wb.Sheets(1).Range("AC13").Copy wbMaster.Sheets(1).Range("B" & lngRow + 1)
wb.Sheets(1).Range("T18:T20").Copy wbMaster.Sheets(1).Range("A" & lngRow + 3)
wb.Sheets(1).Range("AC18:AC20").Copy wbMaster.Sheets(1).Range("B" & lngRow + 3)
wb.Sheets(1).Range("T25:T35").Copy wbMaster.Sheets(1).Range("A" & lngRow + 7)
wb.Sheets(1).Range("AC25:AC35").Copy wbMaster.Sheets(1).Range("B" & lngRow + 7)

' paste values
wb.Sheets(1).Range("AC15").Copy
wbMaster.Activate
Sheets(1).Range("B" & lngRow + 2).PasteSpecial xlPasteValues

wb.Sheets(1).Range("AC22").Copy
Sheets(1).Range("B" & lngRow + 6).PasteSpecial xlPasteValues

Application.CutCopyMode = False
wb.Close False
End If

' find next file
strFile = Dir()
Loop

ExitHere:
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox Err.Number & ": " & Err.Description
Resume ExitHere
End Sub

[dmat619]

Thanks very much for all your help. This is working perfectly now.