Results 1 to 6 of 6
  1. #1
    New Lounger
    Join Date
    Nov 2015
    Posts
    3
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Need Excel macro to copy from a file, paste into another

    Hello,

    first i'd like to tell you why i'm asking for help, i have an Old coworker which the IT Deparment are not helping in creating the Macro he wants which sounds simple (After reading a lot), he helps everyone and i want to help him in this so he can have an easier working day.

    Basically what he does is copying and pasting, so lets say Folder1 has Files 1 to 10, File 1 is the Excel Template where he needs to paste in, and 2 to 10 have the excel files where he needs to copy the data from (It's way bigger than this around 800 files a week).

    Can we create a Macro that where he just needs to put the files in a pre determined folder and it copies it into the template when he wants them ?

    So let's say Template September has Accounts Receivable 1 USD, Accounts Receivable 1 EUR, Accounts Receivable 1 CHF and File 2 Accounts Receivable has all September Accounts Receivable 1 USD, 1 EUR and 1 CHF. Instead of opening each file and copying into the Template i'm trying to do make him open only the Template and by a Macro collect all information ?

    Thank you a lot, and i am sorry because i am not really a professional in VBA !

  2. #2
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts
    Yes that process can be automated but you will need to provide sample files that are the template and a few sample input documents with instructions on what cells need to be copied and where it goes in the template.
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  3. The Following User Says Thank You to Andrew Lockton For This Useful Post:

    Fares (2015-11-06)

  4. #3
    New Lounger
    Join Date
    Nov 2015
    Posts
    3
    Thanks
    1
    Thanked 0 Times in 0 Posts
    Sure here they are:
    Sea payables 015.png
    Sep ex 015 to 50.png
    Sep ex 015 to 230.png
    Sep ex 015 to 370 TWD.png
    Sep ex 015 to 370 USD.png

    Sep ex 015 to 50.xlsxSep ex 015 to 230.xlsxSep ex 015 to 370.xlsxSea payables 015.xlsx

    So Basically what i'm trying to accomplish is automating the copying and pasting of the Sheets in the Workbooks to the assigned sheets in "Sea Payables"

    As example: The Macro Workbook is "Sea Payables 015" which has a Sheet called "AR 50 - AP 15", inside this sheet i copy and insert the Sheet named "Sea Freight" from the Workbook with name "Sep ex 015 to 50" overwriting what was there already, and so on. (Some workbooks have more than one Sea sheet because of the different currencies).

    Would that be possible ? Thank you so much if you could help me.

  5. #4
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts
    I'm sure there are more elegant ways of doing this although you haven't helped with the sheet and filenames logic. Anyway, here is my clumsy first attempt at doing the task. Note that the copy and paste will fail with the merged cells you have in your sample workbooks so you need to get rid of those before running the code.

    Put the macro into your Sea Payables workbook and change the type to xlsm to allow the macro to be saved.
    Code:
    Sub GetData()
      Dim aWkbk As Workbook, aSht As Worksheet
      Dim sPath As String, aRng As Range
      Dim aShtTarget As Worksheet
      
      sPath = ActiveWorkbook.Path & "\"
      Debug.Print sPath
      
      Set aWkbk = Workbooks.Open(Filename:=sPath & "Sep ex 015 to 50.xlsx")
      Set aSht = aWkbk.Sheets("Sea Freight")
      Set aShtTarget = ThisWorkbook.Sheets("AR 50 - AP 015")
      aSht.UsedRange.Copy
      aShtTarget.Range("A1").PasteSpecial xlPasteAll
      aWkbk.Close SaveChanges:=False
      
      Set aWkbk = Workbooks.Open(Filename:=sPath & "Sep ex 015 to 230.xlsx")
      Set aSht = aWkbk.Sheets("Sea EUR")
      Set aShtTarget = ThisWorkbook.Sheets("AR 230 - AP 015")
      aSht.UsedRange.Copy
      aShtTarget.Range("A1").PasteSpecial xlPasteAll
      aWkbk.Close SaveChanges:=False
      
      Set aWkbk = Workbooks.Open(Filename:=sPath & "Sep ex 015 to 370.xlsx")
      Set aSht = aWkbk.Sheets("Sea USD")
      Set aShtTarget = ThisWorkbook.Sheets("AR 370 to AP 015 USD")
      aSht.UsedRange.Copy
      aShtTarget.Range("A1").PasteSpecial xlPasteAll
      '------------ same source
      Set aSht = aWkbk.Sheets("Sea TWD")
      Set aShtTarget = ThisWorkbook.Sheets("AR 370 to AP 015 TWD")
      aSht.UsedRange.Copy
      aShtTarget.Range("A1").PasteSpecial xlPasteAll
      aWkbk.Close SaveChanges:=False
      
      Application.CutCopyMode = False
    End Sub
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  6. #5
    New Lounger
    Join Date
    Nov 2015
    Posts
    3
    Thanks
    1
    Thanked 0 Times in 0 Posts
    I have actually tried to write it down like this, but it too time consuming as there are over a thousand files, so probably i'll have to write it down with each number and when the customers report, they'll have a template so all names of the worksheets are the same and everything gets copied as needed.

    But do you have any idea about an If function ?, as example October had file 1 and 2 and 3, but November had 1 and 3, so the macro wont just get stuck searching for file 2 it jumps to file 3 if not found and so on ?


    Sheets("AR 050 - AP 015").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 050.xlsx"
    Windows("Sept to 015 ex 050.xlsx").Activate
    Sheets("Sea Freight").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 050 - AP 015").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 050.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Sheets("AR 230 - AP 015").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 230.xlsx"
    Windows("Sept to 015 ex 230.xlsx").Activate
    Sheets("sea").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 230 - AP 015").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 230.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Sheets("AR 241 - AP 015").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 241.xlsx"
    Windows("Sept to 015 ex 241.xlsx").Activate
    Sheets("SEA").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 241 - AP 015").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 241.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Sheets("AR 370 - AP 015 TWD").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 370.xlsx"
    Windows("Sept to 015 ex 370.xlsx").Activate
    Sheets("SEA-TWD").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 370 - AP 015 TWD").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 370.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Sheets("AR 370 - AP 015 USD").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 370.xlsx"
    Windows("Sept to 015 ex 370.xlsx").Activate
    Sheets("SEA-USD").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 370 - AP 015 USD").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 370.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close


    Sheets("AR 376 - AP 015 HKD").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 376.xlsx"
    Windows("Sept to 015 ex 376.xlsx").Activate
    Sheets("Seafreight HKD").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 376 - AP 015 HKD").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 376.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Sheets("AR 376 - AP 015 USD").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 376.xlsx"
    Windows("Sept to 015 ex 376.xlsx").Activate
    Sheets("Seafreight USD").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 376 - AP 015 USD").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 376.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Sheets("AR 383 - AP 015 EUR").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 383.xlsx"
    Windows("Sept to 015 ex 383.xlsx").Activate
    Sheets("SEAFREIGHT--EUR").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 383 - AP 015 EUR").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 383.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close


    Sheets("AR 383 - AP 015 RMB").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 383.xlsx"
    Windows("Sept to 015 ex 383.xlsx").Activate
    Sheets("SEAFREIGHT--RMB").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 383 - AP 015 RMB").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 383.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Sheets("AR 383 - AP 015 USD").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 383.xlsx"
    Windows("Sept to 015 ex 383.xlsx").Activate
    Sheets("SEAFREIGHT--USD").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 383 - AP 015 USD").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 383.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Sheets("AR 383 - AP 015 HKD").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 383.xlsx"
    Windows("Sept to 015 ex 383.xlsx").Activate
    Sheets("SEAFREIGHT--HKD").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 383 - AP 015 HKD").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 383.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Sheets("AR 384 - AP 015 RMB").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 384.xlsx"
    Windows("Sept to 015 ex 384.xlsx").Activate
    Sheets("SeaFreight RMB").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 383 - AP 015 RMB").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 384.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Sheets("AR 384 - AP 015 USD").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 384.xlsx"
    Windows("Sept to 015 ex 384.xlsx").Activate
    Sheets("SeaFreight USD").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 384 - AP 015 USD").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 384.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close


    Sheets("AR 384 - AP 015 EUR").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 384.xlsx"
    Windows("Sept to 015 ex 384.xlsx").Activate
    Sheets("SeaFreight EUR").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 384 - AP 015 EUR").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 384.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Sheets("AR 430 - AP 015").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 430.xlsx"
    Windows("Sept to 015 ex 430.xlsx").Activate
    Sheets("SEA").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 430 - AP 015").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 430.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close


    Sheets("AR 449 - AP 015").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 449.xlsx"
    Windows("Sept to 015 ex 449.xlsx").Activate
    Sheets("SEA FREIGHT").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 449 - AP 015").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 449.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Sheets("AR 450 - AP 015").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 450.xlsx"
    Windows("Sept to 015 ex 450.xlsx").Activate
    Sheets("SEA").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 450 - AP 015").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 450.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close


    Sheets("AR 456 - AP 015").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 456.xlsx"
    Windows("Sept to 015 ex 456.xlsx").Activate
    Sheets("Sea ").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 456 - AP 015").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 456.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close


    Sheets("AR 471 - AP 015").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 471.xlsx"
    Windows("Sept to 015 ex 471.xlsx").Activate
    Sheets("SF SOA").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 471 - AP 015").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 471.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close



    Sheets("AR 480 - AP 015").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 480.xlsx"
    Windows("Sept to 015 ex 480.xlsx").Activate
    Sheets("SEAFREIGHT").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 480 - AP 015").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 480.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close



    Sheets("AR 749 - AP 015").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 749.xlsx"
    Windows("Sept to 015 ex 749.xlsx").Activate
    Sheets("SEA FREIGHT").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 749 - AP 015").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 749.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close



    Sheets("AR 750 - AP 015 ").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 750.xlsx"
    Windows("Sept to 015 ex 750.xlsx").Activate
    Sheets("Sea").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 750 - AP 015 ").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 750.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close


    Sheets("AR 757 - AP 015 USD").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 757.xlsx"
    Windows("Sept to 015 ex 757.xlsx").Activate
    Sheets("SEA USD").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 750 - AP 015 ").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 757.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

    Sheets("AR 760 - AP 015").Select
    Workbooks.Open Filename:="H:\HO\FLT\Treasury\Netting\04_Netting\2 015\09_Sept\05_Statements\Payables\Sept to 015 ex 760.xlsx"
    Windows("Sept to 015 ex 760.xlsx").Activate
    Sheets("Seafreight").Select
    Cells.Select
    Selection.Copy
    Windows("Sea payables 015.xlsm").Activate
    Cells.Select
    Sheets("AR 760 - AP 015").Select
    Cells.Select
    ActiveSheet.Paste
    Workbooks("Sept to 015 ex 760.xlsx").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Close

  7. #6
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts
    Testing whether a file exists is easy enough eg
    Code:
    sFile = "C:\Work\file.xlsx"
    If Dir(sFile) <> "" Then
        MsgBox "File exists."
    Else
        MsgBox "File doesn't exist."
    End If
    HOWEVER: If you are dealing with 800 files it is just not practical to code it all manually (especially since it appears to be month specific) and so you need to identify patterns in naming files/sheets so you can loop through files and sheets and copy the relevant data to the relevant target. The trick will be working out a pattern for matching a found sheet with a target sheet name that you need to paste into.

    Looping through a folder of files is more complicated but it avoids the need to test for the existence of a file. There are plenty of examples for such vba loops if you do a search.
    Andrew Lockton, Chrysalis Design, Melbourne Australia

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •