-
Solved: copy cells from many .xls files to master file
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.
-
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 recording
This will give you your starting point, and we can help you further from there.
-
Here is the recorded macro
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.
[vba]
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
[/vba]
Edited 15-Jun-2007 by geekgirlau. Reason: insert vba tags
-
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.
[VBA]
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
[/VBA]
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.
-
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
-
In that case you may need to do a paste value rather than paste
[vba]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[/vba]
-
Thank you
Thanks very much for all your help. This is working perfectly now.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules