Solved: Importing data from other Excel spreadsheets

[zagrijs]

Hi I need to import data from other spreadsheets into one spreadsheet. I have read the articles and copied code that deals with the subject, but haven't found exactly what I'm looking for.

The spreadsheet have the same number of worksheet and the worksheets are named the same.
Sheet1 on Workbook1 has the same structure as Sheet1 in Workbook2, Sheet2 in Workbook1 the same as Sheet2 in Workbook2; that applies to all sheets.

But Sheet1 doesn't have the same structure as Sheet2, Sheet2 not the same structure as Sheet3, etc. Every sheet has its own structure.

Could anyone please direct me to the correct article on the subject or assist me with sample code?

Thanks in advance

[snb]

[VBA]Sub M_snb()
c00="G:\OF\"
c01=dir(c00 & "*.xlsx")

do until c01=""
c02=c02 & "|"&c00 & c01
loop
sn=split(mid(c02,2),"|")
sp=sn
st=sn

for j=0 to ubound(sn)
with getobject(sn(j))
sn(j)=.sheets("sheet1").usedrange
sp(j)=.sheets("sheet2").usedrange
st(j)=.sheets("sheet3").usedrange
.close false
next
next

with thisworkbook
for j=0 to ubound(sn)
for jj=1 to 3
.sheets("sheet" & jj).cells(rows.count,1).end(xlup).offset(1).resize(ubound(choose(jj,sn(j),s p(j),st(j))),ubound(choose(jj,sn(j),sp(j),st(j)),2))=choose(jj,sn(j),sp(j), st(j))
next
next
end with
End Sub[/VBA]

[zagrijs]

Thanks snb.

I have been unable to get the sub to work. I created two sample workbooks and copied them to a memory stick (H and changed the pathway accordingly. I changed "xlsx" to "xlsm" in the code and saved both files in that format, the one with a module in with your sub.

The first "next" in the 2nd loop is obviously incorrect, caused an error and I changed it to "end with".

However, when I ran the sub it caused Excel to go into "not responding" mode and I had to use the Task Manager to end Excel.

Your code uses functions that I'm not familiar with and I thus do not follow exactly what it is suppose to do. I can see that it creates an array of the workbooks and then loops through them selecting all the used ranges and copy them, but I don't understand enough to be able to pinpoint what is wrong.

[zagrijs]

Mistake. Not (H but ("H:")

[snb]

You can follow the code step by step using F8

The code should be in a separate workbook, containing as many (3) sheets as the other workbooks;
Each workbook to be imported should contain at least 3 sheets: sheet1, sheet2 and sheet 3. Otherwise you need to adapt the code.

[vba]Sub M_snb()
c00="G:\OF\"
c01=dir(c00 & "*.xlsx")

Do Until c01=""
c02=c02 & "|"&c00 & c01
Loop
sn=split(mid(c02,2),"|")
sp=sn
st=sn

For j=0 To UBound(sn)
With getobject(sn(j))
sn(j)=.sheets("sheet1").usedrange
sp(j)=.sheets("sheet2").usedrange
st(j)=.sheets("sheet3").usedrange
.close False
End with
Next

With thisworkbook
For j=0 To UBound(sn)
For jj=1 To 3
.sheets("sheet" & jj).cells(rows.count,1).end(xlup).offset(1).resize(UBound(choose(jj,sn(j),s p(j),st(j))),UBound(choose(jj,sn(j),sp(j),st(j)),2))=choose(jj,sn(j),sp(j), st(j))
Next
Next
End With
End Sub[/vba]

PS this forum has a horrible VBA code interpreter !!

[zagrijs]

Thanks snb.

I have in the mean time modified one of the other pieces of code that I found. It works fine for one or two pages and then error that it cannot "paste" . Would you kindly check the code and advise if it is the code or maybe something in the spreadsheet itself?

[VBA]Sub importDataFromOtherWorkbooks()
Dim sPath As String 'string variable to hold the path to look through
Dim sFilename As String 'temporary filename string variable
Dim tempWorkBook As Workbook 'temporary workbook (each in directory)
Dim tempWorkSheet As Worksheet 'temporary worksheet variable
Dim RowCount As Long 'Rows used on master sheet
Dim uRange As Range 'usedrange for each temporary sheet
Dim sLastDataRow As String 'variable to store last row with data
sPath = ThisWorkbook.Path & "\filesToImport\" 'Change as needed, ie "C:\"

Application.EnableEvents = False 'turn off events
Application.ScreenUpdating = False 'turn off screen updating

If Right(sPath, 1) <> Application.PathSeparator Then 'if path doesnt end in "\"
sPath = sPath & Application.PathSeparator 'add "\"

End If

sFilename = Dir(sPath & "*.xlsm", vbNormal) 'set first file's name to filename variable

Do Until sFilename = "" 'loop until all files have been parsed
If sPath <> ThisWorkbook.Path And sFilename <> ThisWorkbook.Name Then
Set tempWorkBook = Workbooks.Open(FileName:=sPath & sFilename) 'open file, set to tempWorkBook variable

For Each tempWorkSheet In tempWorkBook.Worksheets 'loop through each sheet
If tempWorkSheet.Name = "DisciplinaryCases" _
Or tempWorkSheet.Name = "PrecautionarySuspensions" _
Or tempWorkSheet.Name = "Appeals" _
Or tempWorkSheet.Name = "Grievances" _
Or tempWorkSheet.Name = "Disputes" Then

tempWorkSheet.Activate 'activate temporary worksheet
ActiveSheet.Cells.Select 'select the entire sheet
ActiveSheet.Unprotect Password:="impilo2012" 'unprotect sheet
Selection.Rows.EntireRow.Hidden = False 'unhide all hidden rows
ActiveSheet.Protect Password:="impilo2012" 'protect sheet again

Set uRange = tempWorkSheet.Range("A2", tempWorkSheet.Cells(tempWorkSheet.UsedRange.Row + tempWorkSheet.UsedRange.Rows _
.Count - 1, tempWorkSheet.UsedRange.Column + tempWorkSheet.UsedRange.Columns.Count - 1)) 'set used range

sLastDataRow = tempWorkSheet.Cells(Rows.Count, "A").End(xlUp).Row 'store last row number of last data row in variable

ActiveSheet.Range(uRange.Address).Select
Selection.Copy 'copy selected data
ThisWorkbook.Worksheets(ActiveSheet.Name).Activate 'activate workbook with same name in this workbook
ActiveSheet.Range("A" & Trim(Str(Cells(Rows.Count, "A").End(xlUp).Row + 1))).Select
ActiveSheet.Unprotect Password:="impilo2012"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Protect Password:="impilo2012"
Application.CutCopyMode = False

End If

Next 'tempWorkSheet
tempWorkBook.Close False 'close temporary workbook without saving

End If
sFilename = Dir() 'set next file's name to FileName variable

Loop

Application.EnableEvents = True 're-enable events
Application.ScreenUpdating = True 'turn screen updating back on

'Clear memory of the object variables
Set tempWorkBook = Nothing
Set tempWorkSheet = Nothing
Set uRange = Nothing
End Sub
[/VBA]

Thanks

[snb]

If you have any questions about the suggestion I did,I will answer those...

As long as you do not post samples of the workbooks you want to inegrate it's merely guessing.

[zagrijs]

The first loop in your suggestion goes into an endless loop adding each time another reference to the same file. I do not know how to correct it because I don't understand the code.

[snb]

That makes sense:

[VBA]

Sub M_snb()
c00="G:\OF\"
c01=dir(c00 & "*.xlsx")

Do Until c01=""
c02=c02 & "|"&c00 & c01
c01=dir
Loop
sn=split(mid(c02,2),"|")
sp=sn
st=sn

For j=0 To UBound(sn)
With getobject(sn(j))
sn(j)=.sheets("sheet1").usedrange
sp(j)=.sheets("sheet2").usedrange
st(j)=.sheets("sheet3").usedrange
.close False
End With
Next

With thisworkbook
For j=0 To UBound(sn)
For jj=1 To 3
.sheets("sheet" & jj).cells(rows.count,1).end(xlup).offset(1).resize(UBound(choose(jj,sn(j),s p(j),st(j))),UBound(choose(jj,sn(j),sp(j),st(j)),2))=choose(jj,sn(j),sp(j), st(j))
Next
Next
End With
End Sub

[/VBA]

[zagrijs]

When it gets to the 1st line of the second loop [VBA]sn(j) = .Sheets("sheet1").UsedRange[/VBA] it gives an error msg "Type Mismatch".

[snb]

try

[VBA]

sn(j) = .Sheets("sheet1").UsedRange.Value

[/VBA]

[zagrijs]

Gives same error.

[snb]

[VBA]
Sub M_snb()
c00="G:\OF\"
c01=dir(c00 & "*.xlsx")

Do Until c01=""
c02=c02 & "|"&c00 & c01
c01=dir
Loop
sn=split(mid(c02,2),"|")

redim sp(ubound(sn))
sq=sp
st=sp

For j=0 To UBound(sn)
With getobject(sn(j))
sp(j)=.sheets("sheet1").usedrange
sq(j)=.sheets("sheet2").usedrange
st(j)=.sheets("sheet3").usedrange
.close False
End With
Next

With thisworkbook
For j=0 To UBound(sn)
For jj=1 To 3
.sheets("sheet" & jj).cells(rows.count,1).end(xlup).offset(1).resize(UBound(choose(jj,sp(j),s q(j),st(j))),UBound(choose(jj,sp(j),sq(j),st(j)),2))=choose(jj,sp(j),sq(j), st(j))
Next
Next
End With
End Sub
[/VBA]

[zagrijs]

Thanks. Its working now with simple sample spreadsheets. Will have to adapt it though for my application. So I'm not marking the thread as solved yet because I might still need some assistance.

[zagrijs]

At last I got it going in my application. Thanks again snb.