Consulting

Results 1 to 7 of 7

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

  1. #1
    VBAX Regular
    Joined
    Jun 2007
    Posts
    8
    Location

    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.

  2. #2
    Moderator VBAX Master geekgirlau's Avatar
    Joined
    Aug 2004
    Location
    Melbourne, Australia
    Posts
    1,464
    Location
    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,
    1. Start recording a macro
    2. Open the master workbook
    3. Open the first workbook
    4. Copy Z5
    5. Go to the master workbook
    6. Paste the data into A1
    7. Go to the first workbook
    8. Copy AC25-AC35
    9. Go to the master workbook
    10. Paste the data into A2
    11. Stop recording
    This will give you your starting point, and we can help you further from there.

  3. #3
    VBAX Regular
    Joined
    Jun 2007
    Posts
    8
    Location

    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

  4. #4
    Moderator VBAX Master geekgirlau's Avatar
    Joined
    Aug 2004
    Location
    Melbourne, Australia
    Posts
    1,464
    Location
    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.

  5. #5
    VBAX Regular
    Joined
    Jun 2007
    Posts
    8
    Location
    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

  6. #6
    Moderator VBAX Master geekgirlau's Avatar
    Joined
    Aug 2004
    Location
    Melbourne, Australia
    Posts
    1,464
    Location
    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]

  7. #7
    VBAX Regular
    Joined
    Jun 2007
    Posts
    8
    Location

    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
  •