unable to copy the data from Excelsheet byVBA Macro

Hi There,

Iam new this Forum,Iam glade to join in this Forum, i saw couple of threads in this forum very interesting ...

Iam also having some problem like below with my Excell File.

iam having the peculier problem with my Excel file.

Please find my Problem below.

Iam running 1 macro which will copy n's Excel sheets data and consulidate in 1 file in the specified directory.

but i get the data from my user 100's of excel files in the directory.

what could be the problem, if i run my macro onthe user's file i cann't copy anything from their files.

but if i copy & paste the data manually into another file ..then my macro is able consolidate the data into 1 sheet.

what could be the problem?either with the Excell file ?? or my macro?? but my macro works fine with other set's of files.

Please can u give me some tips to debug my problem???

is there any file permission ???

iam breaking my head with this problem...

Thanks in advance...

Hi,

It would be easier if you could copy the macro in your message,
to have precise answer to your question ...
otherwise, the guess would be around the directory definition in your macro

HTH
Cheers
Carim

Hi Carim,

Really thanks for the immediate response,

as per ur mail iam sending the macro for ur perusal....Thanks in advance for helping me in giving the solution to my problem....

below is the macro code....

Sub Example2()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long

'Fill in the path\folder where the files are
MyPath = "C:\Test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
'clear all cells on the first sheet
basebook.Worksheets(1).Cells.Clear
rnum = 1

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
Dim RN As String
Dim FR As Integer
'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
If Fnum = 1 Then
'Header row first time assuming 12th Row
RN = "B12" & ":" & "AA12"
Set sourceRange = mybook.Worksheets(1).Range(RN)
Set destrange = basebook.Worksheets(1).Range("B" & rnum)
sourceRange.Copy destrange
rnum = rnum + 1
End If
FR = SearchRow(mybook, Sheet1, 1, 2, "Pin No.") + 2
'FR = 14
Lr = SearchRow(mybook, Sheet1, FR, 2, "")
RN = "B" & FR & ":" & "AA" & Lr
'RN = "B14:AA16"
Set sourceRange = mybook.Worksheets(1).Range(RN)
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Range("B" & rnum)

' This will add the workbook name in column D if you want
basebook.Worksheets(1).Cells(rnum, "AB").Value = mybook.Name

sourceRange.Copy destrange
' Instead of this line you can use the code below to copy only the values

' With sourceRange
' Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _
' Resize(.Rows.Count, .Columns.Count)
'End With
'destrange.Value = sourceRange.Value

rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub
---------------------------------------------------------------------
Function SearchRow(mb As Workbook, sh As Worksheet, Rw As Integer, col As Integer, str As String) As Integer
Dim ws As Worksheet
Dim wb As Workbook
Set ws = sh
Set wb = mb
'Lrow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For Z = Rw To 100
With wb.Sheets.Item(1)
If .Cells(Z, col) = str Then
SearchRow = Z
Exit For
End If
End With
Next Z
End Function




Thanks & Regards,
Chandra.