Overflow error in range - when we copy data from multiple workbooks

renuvish

New Member
Joined
Aug 2, 2014
Messages
4
Dear all,
I am new to <acronym title="visual basic for applications">VBA</acronym> and this forum. I have been struggling with this new piece of code that i have managed to write. I find this works fine for some files , but some files it does not copy the data.

This macro , opens a directory , and from all the excel workbooks in that directory , it opens the second worksheet and copies the data from column A to column U , into the workbook on which the macro is kept ,into worksheet 4

I tried to put error handling and i observe it gives error code 6 :Overflow error.

Another observation was , i was trying to find out the difference between the file from which it was able to copy and the file which it is not copying. I could not make out much. I tried copying the format of the file which was working and used the same format (using format painter) in the other files which did not work , and surprisingly after i did that, it works fine.

I am unable to figure out what the formatting related thing has got to do with this code.
I am not sure how to handle this. Any help would be of great assistance to me

CODE
Sub MergeAllWorkbooks()
On Error GoTo finish
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim DestLastRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim filecount As Integer

' Set the sheet where data has to be copied
Set SummarySheet = ThisWorkbook.Worksheets(4)

'Get the folder where the files are present

FolderPath = GetFolder("D:\") + "\"


' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")


' Clear the existing data in the utility test results sheet

Dim mbResult As Long
mbResult = MsgBox("Do you want to clear the data in the Test Results worksheet of the IPR utility?", vbYesNo)

' SourceLastRow keeps track of where to insert new rows in the destination workbook.

DestLastRow = SummarySheet.Columns(36).Find(What:="*", _
After:=SummarySheet.Cells.Range("AJ1"), _
SearchDirection:=xlPrevious, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows).Row

If mbResult = vbYes And DestLastRow > 1 Then
SummarySheet.Range("A2" & ":U" & DestLastRow).Clear
SummarySheet.Range("AJ2:AJ" & DestLastRow).Clear
DestLastRow = 1​

End If

' Loop until Dir returns an empty string.

filecount = 0

Application.ShowWindowsInTaskbar = False
Application.ScreenUpdating = False

Do While FileName <> ""

filecount = filecount + 1

On Error Resume Next
' Open a workbook in the folder

Set WorkBk = Workbooks.Open(FolderPath & FileName)

Application.StatusBar = "Fetching Data from File : " & FileName

' to turn off filters in the source files
If WorkBk.Worksheets(2).AutoFilterMode Then
If WorkBk.Worksheets(2).FilterMode Then
WorkBk.Worksheets(2).ShowAllData
End If
ElseIf WorkBk.Worksheets(2).FilterMode Then
WorkBk.Worksheets(2).ShowAllData
End If


' Set the source range

'
It can span multiple rows.

Dim LastRow As Long
LastRow = WorkBk.Worksheets(2).Cells.Find(What:="*", _
After:=WorkBk.Worksheets(2).Cells.Range("A1"), _
SearchDirection:=xlPrevious, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows).Row


Set SourceRange = WorkBk.Worksheets(2).Range("A2:U" & LastRow)


' Set the destination range to start at column A and be the same size as the source range.


Set DestRange = SummarySheet.Range("A" & DestLastRow + 1)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)


' Copy over the values from the source to the destination.

DestRange.Value = SourceRange.Value


SummarySheet.Range("AJ" & DestLastRow + 1 & ":AJ" & LastRow + DestLastRow).Value = FileName


'
Increase DestLastRow so that we know where to copy data next.
DestLastRow = DestLastRow + DestRange.Rows.Count

'
Close the source workbook without saving changes.
WorkBk.Close savechanges:=False

' Use Dir to get the next file name.
FileName = Dir()
Loop
Application.StatusBar = "Data Fetched Successfully"
Application.ShowWindowsInTaskbar = True
Application.ScreenUpdating = True

' Call AutoFit on the destination sheet so that all data is readable.

MsgBox ("The data has been successfully copied from " & filecount & " files")

SummarySheet.Columns.AutoFit
SummarySheet.Columns("V").Hidden = True
SummarySheet.Columns("W").Hidden = True
SummarySheet.Columns("X").Hidden = True
SummarySheet.Columns("Y").Hidden = True
SummarySheet.Columns("Z").Hidden = True
SummarySheet.Columns("AF").Hidden = True
SummarySheet.Columns("AG").Hidden = True
SummarySheet.Columns("AH").Hidden = True
Exit Sub

finish:
Application.ShowWindowsInTaskbar = True
Application.ScreenUpdating = True
Application.StatusBar = ""
If Err.Number <> 0 Then
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
End If
Resume Next
'MsgBox ("Some error occurred while fetching data from selected files " & vbNewLine & "Copied data from " & filecount & " files")
SummarySheet.Columns.AutoFit
SummarySheet.Columns("V").Hidden = True
SummarySheet.Columns("W").Hidden = True
SummarySheet.Columns("X").Hidden = True
SummarySheet.Columns("Y").Hidden = True
SummarySheet.Columns("Z").Hidden = True
SummarySheet.Columns("AF").Hidden = True
SummarySheet.Columns("AG").Hidden = True
SummarySheet.Columns("AH").Hidden = True
End Sub
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select the Folder where the files are present"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
ChDir "C:\"
End Function

CODE
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top