Page 1 of 1

[Solved] Copy cells from spreadsheets in a folder to a File

Posted: Sun Oct 01, 2017 7:01 pm
by malcolmr
Hey guys/gals can you help me with this. By using a macro, I want to copy from specific cells from lots of spreadsheets by looping through all of them inside a folder and store the data into a single spreadsheet where I will give the location of the cells.

Example:

Code: Select all


Sub S_import_from_A_C

oCdoc=thiscomponent
sURLFolder=replace(oCdoc.url,oCdoc.title,"")
oCSheet=oCdoc.sheets(0)
dim i as integer

i=1

Dim FileProperties(2) As New com.sun.star.beans.PropertyValue
FileProperties(0).Name = "FilterName"
FileProperties(0).Value ="scalc: Text - txt - csv (StarOffice Calc)"
FileProperties(1).Name = "USE_CONFIG"
FileProperties(1).Value ="3"
FileProperties(2).Name = "Hidden"
FileProperties(2).Value = True

sURLFolderA=sURLFolder+"*.ods"

Do While Len(sURLFolderA)>0
oAdoc = StarDesktop.loadComponentFromURL(sURLFolderA, "_blank", 0, FileProperties())

oASheet=oAdoc.sheets(0)'Tabelle 3
oArange=oASheet.getCellRangeByName("K3")'source
oAarray=oArange.getDataArray()
oCrange=oCSheet.getCellRangeByName("A" & i)'target
oCrange.setDataArray(oAarray)
oArange=oASheet.getCellRangeByName("K4")'source
oAarray=oArange.getDataArray()
oCrange=oCSheet.getCellRangeByName("B" & i)'target
oCrange.setDataArray(oAarray)
oAdoc.close (-1)

i=i+1

Loop

End Sub
I'm getting an error while using the above code, while trying to loop through all the files one by one.

Re: Copy cells from spreadsheets in a folder to a Single Fi

Posted: Sun Oct 01, 2017 8:03 pm
by Villeroy

Re: Copy cells from spreadsheets in a folder to a Single Fi

Posted: Mon Oct 02, 2017 1:02 pm
by malcolmr
Can I get a more simpler code like the one above. I just need to loop through all of the Spreadsheets in a folder. Maybe someone can modify the code above and make it more simpler.

Thank You in Advance.

Re: Copy cells from spreadsheets in a folder to a Single Fi

Posted: Mon Oct 02, 2017 4:44 pm
by Villeroy
There is nothing simplier than getDataArray from the used range of a sheet and then setDataArray on the target sheet. It is a hundred times faster and easier than looping through cells.
Walking through a directory in Basic is possible but awkward.
Non-recursive example:

Code: Select all

d = "/tmp/test/"
a = Array("*.xls", "*.ods", "*.xlsx", "*.xlsm")
for each s in a
	f = dir(d & s)
	while len(f) > 0
		print f
		f = dir
	wend
next
With my template you would have to specify the 4 patterns *.xls, *.ods, *.xlsx, *.xlsm one after the other in cell B3 named "Pattern" and run the macro 4 times.

Side note: You can write macros in Python which is a real programming language for adults.

Re: Copy cells from spreadsheets in a folder to a Single Fi

Posted: Mon Oct 02, 2017 5:17 pm
by malcolmr
Thank you very much for your help. I have "googled" the problem and found that the solution to be much simpler in Microsoft Excel.

Re: Copy cells from spreadsheets in a folder to a Single Fi

Posted: Mon Oct 02, 2017 7:10 pm
by Villeroy
malcolmr wrote:Thank you very much for your help. I have "googled" the problem and found that the solution to be much simpler in Microsoft Excel.
Easier than downloading a sheet, fill out 2 or 3 cells and run it once for each file name pattern?

Re: Copy cells from spreadsheets in a folder to a Single Fi

Posted: Mon Oct 02, 2017 9:31 pm
by malcolmr
Villeroy wrote: Easier than downloading a sheet, fill out 2 or 3 cells and run it once for each file name pattern?
I guess so :).

Code: Select all


Sub ImportKeyDataFromCSVs()
'Author:    Jerry Beaucaire
'Date:      3/27/2014
'Summary:   Import specific data from all CSV files from a folder into a single sheet
Dim wbCSV   As Workbook
Dim wsMstr  As Worksheet
Dim fPath   As String
Dim fCSV    As String
Dim NR      As Long
 
fPath = "C:\2010\Import\"                       'path to CSV files, include the final \ in this string
Set wsMstr = ThisWorkbook.Sheets("MasterCSV")   'sheet in thisworkbook to collate data into
                                                'optionally clear prior data, skipping row1 titles
If MsgBox("Clear the existing MasterCSV sheet before importing?", vbYesNo, "Clear?") _
    = vbYes Then wsMstr.UsedRange.Offset(1).ClearContents
NR = wsMstr.Range("A" & Rows.Count).End(xlUp).Row + 1   'next empty row to add
 
Application.ScreenUpdating = False  'speed up macro
fCSV = Dir(fPath & "*.csv")         'start the CSV file listing
    Do While Len(fCSV) > 0
        Set wbCSV = Workbooks.Open(fPath & fCSV)    'open a CSV file
                                                    'copy key data cells into master sheet and close source file,
                                                    'add as many key cells in this section as needed
        wsMstr.Range("A" & NR).Value = Range("H7").Value
        wsMstr.Range("B" & NR).Value = Range("M7").Value
        wsMstr.Range("C" & NR).Value = Range("N7").Value
        wsMstr.Range("D" & NR).Value = Range("F7").Value
        wsMstr.Range("E" & NR).Value = Range("J7").Value
        wsMstr.Range("F" & NR).Value = Range("K7").Value
        
        wbCSV.Close False           'close the opened CSV
        NR = NR + 1                 'increment next target row
        fCSV = Dir                  'ready next CSV filename
    Loop
 
Application.ScreenUpdating = True
End Sub

Btw here's the code which I've found online. I will be forever grateful to you if you can help me convert it, so that I can use it in OpenOffice Calc.

Re: [Solved] Copy cells from spreadsheets in a folder to a

Posted: Tue Oct 03, 2017 12:57 pm
by Villeroy
You know that this macro does a completely different thing?