Workbooks to one worksheet

vaibhav saini

New member
Joined
Mar 4, 2014
Messages
3
Reaction score
0
Points
0
Hi All,

I am new to macros. I have different workbooks. I need to copy sheet1(can be of other name) of all workbooks to one master sheet (new). My code runs successfully but no data is copied. Below is my code. Please help:

Sub Consolidate()

Dim objExcel As Object, objRange As Range
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, objWorkbook As Workbook, objWorksheet As Worksheet, wsMaster As Worksheet

'Setup
Application.ScreenUpdating = False 'speed up macro execution
Application.EnableEvents = False 'turn off other macros for now
Application.DisplayAlerts = False 'turn off system messages for now

Set wsMaster = ThisWorkbook.Sheets("Sheet1") 'sheet report is built into

With wsMaster
If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
.UsedRange.Offset(1).EntireRow.Clear
NR = 2
Else
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'appends data to existing data
End If

fPath = "C:\My Folder\" 'remember final \ in this string
fPathDone = fPath & "Imported\" 'remember final \ in this string
On Error Resume Next
MkDir fPathDone 'creates the completed folder if missing
On Error GoTo 0
fName = Dir(fPath & "*.xls*") 'listing of desired files, edit filter as desired

'Import a sheet from found files
Do While Len(fName) > 0
If fName <> ThisWorkbook.Name Then 'don't reopen this file accidentally
Set wbData = Workbooks.Open(fPath & fName) 'Open file

Set objWorkbook = objExcel.Workbooks.Open(fPath & fName) 'Open file
Set objWorksheet = objWorkbook.Worksheets(1)
Set objRange = objWorksheet.UsedRange
MsgBox LR
MsgBox NR
LR = objRange.Rows.Count

Range("A1:A" & LR).EntireRow.Copy Destination:= _
wsMaster.Range("A" & NR)

wbData.Close False 'close file
NR = LR + 1 'Next row

Name fPath & fName As fPathDone & fName 'move file to IMPORTED folder
End If
fName = Dir 'ready next filename
Loop
End With

ErrorExit: 'Cleanup
ActiveSheet.Columns.AutoFit
Application.DisplayAlerts = True 'turn system alerts back on
Application.EnableEvents = True 'turn other macros back on
Application.ScreenUpdating = True 'refreshes the screen
End Sub
 
Have you followed this code as it is running and seen where you have problems?

It seems to be you are trying to open the source files twice.
Set wbData = Workbooks.Open(fPath & fName) 'Open file
Set objWorkbook = objExcel.Workbooks.Open(fPath & fName) 'Open file

you can change the second line to:
Set objWorkbook = wbData

and it should copy some data for you. I had some problems with this when testing it on some random files I had.
The third file I ran did not copy the correct amount of rows. My data was 300+ rows however the line:
LR = objRange.Rows.Count only returned 155.

Also it would be helpful for you to change your NR count from NR = LR +1 to NR = NR + LR
 
Thanks for your time and help Simi.

Corrected the code as per your suggestions :)
Were you able to import the data using this code because I am still not able to import any data. Are there any cautions that I have to take care of, like the files I need to import should not be in xyz formatting or no hyperlinks or something like that. Still can't import anything.
 
put a stop and run the code from the vba, so you can step through the program with f8.
this will help you see where the program is giving you an error.
The sample files I used had different amounts of data and different formats.
 
No error i receive. I can track that file is opening, i can get out put of number of rows and columns that make sure that it is reading the file. Then files are moving to "Imported" folder too. The only thing not happening is content copy. Can't figure out why :(
 
I'm perplexed by this if it is opening the correct files and reporting the correct number of rows.
Perhaps someone smarter than me on this forum can provide some insight.
To help others figure this out, what version of windows and excel are you using?
 
Back
Top