Copy Data to Master Database

[sureshtrb]

Tried the below code with minor modification to select file referred from
Open 132 files and copy data into master file

My problem is its not copying the entire data. Copies only few 3 or 4 rows.
Please help

Option Explicit

Public Sub CommandButton2_Click()
Dim Master As Workbook
Dim sourceBook As Workbook
Dim sourceData As Worksheet
Dim CurrentFileName As String
Dim myPath As String
Dim MyFile As Object
Dim Fileselected As String


Application.ScreenUpdating = False
Application.DisplayAlerts = False


'The folder containing the files to be recap'd
myPath = "C:\Users\VSD\Desktop\Reports\"






Set MyFile = Application.FileDialog(msoFileDialogFilePicker)
With MyFile
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
Fileselected = .SelectedItems(1)
End With


'Finds the name of the first file of type .xls in the current directory
CurrentFileName = Dir(Fileselected)


'Create a workbook for the recap report
Set Master = ThisWorkbook


Do
    Workbooks.Open (myPath & CurrentFileName)
    Set sourceBook = Workbooks(CurrentFileName)
    Set sourceData = sourceBook.Worksheets(2)
    
        With sourceData
           .Range("A5:FT" & Range("A" & Rows.Count).End(xlUp).Row).Copy Master.Worksheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End With
       
    sourceBook.Close
  
'Calling DIR w/o argument finds the next .xlsx file within the current directory.
CurrentFileName = Dir()
Loop While CurrentFileName <> ""


MsgBox "Data Copied to Master DataBase-" & vbNewLine & "Done"


Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

 

[dmt32]

Re: [Solved]Re: Copy Data to Master Database

Tried not successful

sorry, should read what I type before I post!

see if this helps:

Dim dest As Range
Do
    Set sourcebook = Workbooks.Open(myPath & CurrentFileName)
    Set sourcedata = sourcebook.Worksheets(2)
    
    With master.Worksheets(2)
    Set dest = .Cells((.Range("A" & .Rows.Count).End(xlUp).Row), 1)
    End With
        
        dest.Offset(1, 0).Value = Format(Date, "dd/mm/yyyy")
    
        With sourcedata
           .Range("A5:FT" & .UsedRange.Rows.Count).Copy dest.Offset(2, 0)
        End With
       
    sourcebook.Close False
    Set dest = Nothing
  
'Calling DIR w/o argument finds the next .xlsx file within the current directory.
CurrentFileName = Dir()
Loop While CurrentFileName <> ""

Dave

 

[sureshtrb]

Re: [Solved]Re: Copy Data to Master Database

You Are Great.
Yes Got What I want.
Thanks for the effort and time spent.

 

[sureshtrb]

Re: [Solved]Re: Copy Data to Master Database

Dear Dave,
minor change.
when I use the given code, during retrieval, the copied rows were not reflected on the userform and changed to my requirement.
Now working perfectly.
Just for your information and for somebody who may in need.
Thanks
Below the working code

Public Sub CommandButton2_Click()Dim Master As Workbook
Dim sourceBook As Workbook
Dim sourceData As Worksheet
Dim CurrentFileName As String
Dim myPath As String
Dim myFile As Object
Dim Fileselected As String


Application.ScreenUpdating = False
Application.DisplayAlerts = False


'The folder containing the files to be recap'd
myPath = "C:\Users\xxx\Desktop\xxxx\"






Set myFile = Application.FileDialog(msoFileDialogFilePicker)
With myFile
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
Fileselected = .SelectedItems(1)
End With


'Finds the name of the first file of type .xls in the current directory
CurrentFileName = Dir(Fileselected)


'Create a workbook for the recap report
Set Master = ThisWorkbook
  
       
    Dim dest As Range
Do
    Set sourceBook = Workbooks.Open(myPath & CurrentFileName)
    Set sourceData = sourceBook.Worksheets(2)
    
    With Master.Worksheets(2)
    Set dest = .Cells((.Range("A" & .Rows.Count).End(xlUp).Row), 1)
    End With
        
        dest.Offset(0, 0).Value = Format(Date, "mmmm/dd/yyyy")
    
        With sourceData
           .Range("A5:FT" & .UsedRange.Rows.Count).Copy dest.Offset(1, 0)
        End With
       
    sourceBook.Close True
    Set dest = Nothing
  
'Calling DIR w/o argument finds the next .xlsx file within the current directory.
CurrentFileName = Dir()
Loop While CurrentFileName <> ""