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?