• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy from workbook and paste to another

G

giovy30

New Member
Dear friends,

I would like to have a code to create a small report, is anyone able to help me?

I have for each month of the year a workbook called with CODE+DATE:
  • 0000011220_20170131
  • 0000011220_20170228
  • 0000011220_20170331
  • and so on....
All these files contains time series data with the same structure (same name of the sheets, same table structures etc...).

I need to extract from each one of these files 2 cells, specifically:
- from the sheet called "C 0.02b"
- Cells to extract: "R24C5" and "R60C5"

Then I need to copy these two cells in a different workbook, creating a sort of report (so a time series with these two cells for each month of 2017).

Does anybody know how to do that?
 
Hi !

Yes, activate Macro recorder and operate manually with a couple of files :
you will get your own free code base !

Then you could post this code here (using the appropriate icon)
in case of an optimization need …
​
 
Ok I have this code:

Code: 
Sub copypaste()
    Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook, Wb4 As Workbook, Wb5 As Workbook, Wb6 As Workbook, Wb7 As Workbook, Wb8 As Workbook, Wb9 As Workbook, Wb10 As Workbook, Wb11 As Workbook, Wb12 As Workbook
    Dim MainBook As Workbook

    'Open All workbooks first:
    Set Wb1 = Workbooks.Open("D:\VBA\INSTITUTION1_20170131.xlsx")
    Set Wb2 = Workbooks.Open("D:\VBA\INSTITUTION1_20170228.xlsx")
    Set Wb3 = Workbooks.Open("D:\VBA\INSTITUTION1_20170331.xlsx")
    Set Wb4 = Workbooks.Open("D:\VBA\INSTITUTION1_20170430.xlsx")
    Set Wb5 = Workbooks.Open("D:\VBA\INSTITUTION1_20170531.xlsx")
    Set Wb6 = Workbooks.Open("D:\VBA\INSTITUTION1_20170630.xlsx")
    Set Wb7 = Workbooks.Open("D:\VBA\INSTITUTION1_20170731.xlsx")
    Set Wb8 = Workbooks.Open("D:\VBA\INSTITUTION1_20170831.xlsx")
    Set Wb9 = Workbooks.Open("D:\VBA\INSTITUTION1_20170930.xlsx")
    Set Wb10 = Workbooks.Open("D:\VBA\INSTITUTION1_20171031.xlsx")
    Set Wb11 = Workbooks.Open("D:\VBA\INSTITUTION1_20171130.xlsx")
    Set Wb12 = Workbooks.Open("D:\VBA\INSTITUTION1_20171231.xlsx")
    Set MainBook = ThisWorkbook

'Copy and paste:
    Wb1.Sheets("C 76.00.a").Range("E24").Copy
    MainBook.Sheets("DATA").Range("C3").PasteSpecial
    Wb1.Sheets("C 76.00.a").Range("E60").Copy
    MainBook.Sheets("DATA").Range("C4").PasteSpecial
  
    Wb2.Sheets("C 76.00.a").Range("E24").Copy
    MainBook.Sheets("DATA").Range("D3").PasteSpecial
    Wb2.Sheets("C 76.00.a").Range("E60").Copy
    MainBook.Sheets("DATA").Range("D4").PasteSpecial
  
    Wb3.Sheets("C 76.00.a").Range("E24").Copy
    MainBook.Sheets("DATA").Range("E3").PasteSpecial
    Wb3.Sheets("C 76.00.a").Range("E60").Copy
    MainBook.Sheets("DATA").Range("E4").PasteSpecial
  
    Wb4.Sheets("C 76.00.a").Range("E24").Copy
    MainBook.Sheets("DATA").Range("F3").PasteSpecial
    Wb4.Sheets("C 76.00.a").Range("E60").Copy
    MainBook.Sheets("DATA").Range("F4").PasteSpecial
  
'...and so on for all the 12 workbooks...
  
    'Close Wbs:
    Wb1.Close
    Wb2.Close
    Wb3.Close
    Wb4.Close
'...and so on for all the 12 workbooks...

    MainBook.Save
    MainBook.Close
End Sub
When it comes to close the workbooks, it doesn't work (only the main book closes).
 
Would suggest using a loop trough the workbooks instead of opening them all and repeating a lot of code for each of the files.
this perhaps can already help (I don't see you managing alert messages)
Code: 
Wb.close savechanges:=False
Also
Code: 
Application.CutCopyMode=False
might be required after pasting (I believe it was.)
 
Thanks for the suggestions!
I have modified the code but I am very bad with VBA. For the loop I tried but it doesn't really work:

Code: 
For Each wB In Array(Wb1, Wb2, Wb3)
    For TrgtRow = 3 To 5
    wB.Sheets(OriginSheetName).Range("E24").Copy
    MainBook.Sheets("DATA" & SheetNum).Range("C" & TrgtRow).PasteSpecial xlPasteValues
    wB.Sheets(OriginSheetName).Range("E60").Copy
    MainBook.Sheets("DATA" & SheetNum).Range("D" & TrgtRow).PasteSpecial xlPasteValues
    Next TrgtRow
Next wB

Basically it opens each file and pastes the data in the target range (C3:D5) but it also overwrites the data all the time (the idea should be to write the first data in a cell, then the second one in the next closest cell etc.)
 
giovy30
You could test this version ...
It's in Sheet1's code-page.
I cannot test this at all with Your settings and
I can only guess Your output's layout.
 

Attachments

  • giovy30.xlsb
    35.2 KB · Views: 4
giovy30 said:
Ok I have this code:

Code: 
Sub copypaste()
    Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook, Wb4 As Workbook, Wb5 As Workbook, Wb6 As Workbook, Wb7 As Workbook, Wb8 As Workbook, Wb9 As Workbook, Wb10 As Workbook, Wb11 As Workbook, Wb12 As Workbook
    Dim MainBook As Workbook

    'Open All workbooks first:
    Set Wb1 = Workbooks.Open("D:\VBA\INSTITUTION1_20170131.xlsx")
    Set Wb2 = Workbooks.Open("D:\VBA\INSTITUTION1_20170228.xlsx")
    Set Wb3 = Workbooks.Open("D:\VBA\INSTITUTION1_20170331.xlsx")
    Set Wb4 = Workbooks.Open("D:\VBA\INSTITUTION1_20170430.xlsx")
    Set Wb5 = Workbooks.Open("D:\VBA\INSTITUTION1_20170531.xlsx")
    Set Wb6 = Workbooks.Open("D:\VBA\INSTITUTION1_20170630.xlsx")
    Set Wb7 = Workbooks.Open("D:\VBA\INSTITUTION1_20170731.xlsx")
    Set Wb8 = Workbooks.Open("D:\VBA\INSTITUTION1_20170831.xlsx")
    Set Wb9 = Workbooks.Open("D:\VBA\INSTITUTION1_20170930.xlsx")
    Set Wb10 = Workbooks.Open("D:\VBA\INSTITUTION1_20171031.xlsx")
    Set Wb11 = Workbooks.Open("D:\VBA\INSTITUTION1_20171130.xlsx")
    Set Wb12 = Workbooks.Open("D:\VBA\INSTITUTION1_20171231.xlsx")
    Set MainBook = ThisWorkbook

'Copy and paste:
    Wb1.Sheets("C 76.00.a").Range("E24").Copy
    MainBook.Sheets("DATA").Range("C3").PasteSpecial
    Wb1.Sheets("C 76.00.a").Range("E60").Copy
    MainBook.Sheets("DATA").Range("C4").PasteSpecial

    Wb2.Sheets("C 76.00.a").Range("E24").Copy
    MainBook.Sheets("DATA").Range("D3").PasteSpecial
    Wb2.Sheets("C 76.00.a").Range("E60").Copy
    MainBook.Sheets("DATA").Range("D4").PasteSpecial

    Wb3.Sheets("C 76.00.a").Range("E24").Copy
    MainBook.Sheets("DATA").Range("E3").PasteSpecial
    Wb3.Sheets("C 76.00.a").Range("E60").Copy
    MainBook.Sheets("DATA").Range("E4").PasteSpecial

    Wb4.Sheets("C 76.00.a").Range("E24").Copy
    MainBook.Sheets("DATA").Range("F3").PasteSpecial
    Wb4.Sheets("C 76.00.a").Range("E60").Copy
    MainBook.Sheets("DATA").Range("F4").PasteSpecial

'...and so on for all the 12 workbooks...

    'Close Wbs:
    Wb1.Close
    Wb2.Close
    Wb3.Close
    Wb4.Close
'...and so on for all the 12 workbooks...

    MainBook.Save
    MainBook.Close
End Sub
When it comes to close the workbooks, it doesn't work (only the main book closes)
Click to expand...


Your code revisited :​
Code: 
Sub Demo1()
   Const D = "D:\VBA\"
     Dim W As Worksheet, C&, F$
     Set W = ThisWorkbook.Worksheets("DATA")
         C = 2
    Application.ScreenUpdating = False
         F = Dir(D & "INSTITUTION1_2017*.xlsx")
Do Until F = ""
         C = C + 1
    With Workbooks.Open(D & F).Worksheets("C 76.00.a")
        .[E24].Copy W.Cells(3, C)
        .[E60].Copy W.Cells(4, C)
        .Parent.Close False
    End With
         F = Dir
Loop
     Set W = Nothing
    Application.ScreenUpdating = True
    ThisWorkbook.Close True
End Sub
Do you like it ? So thanks to click on bottom right Like !
​
 
Many thanks! it works perfectly!
Is there a way to open a input box to ask the user:
  • to set the folder in which are stored all the source files (because now is fixed with "D:\VBA\");
  • for which institution you want to extract the data (all the files start with the name of the institution: INSTITUTION1, INSTITUTION2, INSTITUTION3...would be nice to let the user decide...)
 
giovy30 - inputboxes ...
You can
a) write 'any folder'
b) write 'any INSTITUTION'
c) write 'any year'
and
You'll get those 12 files with monthly order
and if 'any mistakes', You'll get some hints.
 

Attachments

  • giovy30.xlsb
    38.2 KB · Views: 7
You must log in or register to reply here.
Back
Top