Copying data from mutiple workbooks to one workbook

joelmathew

New Member
Joined
Mar 5, 2015
Messages
35
hi All. Need some help solving existing macro

i got a MAIN workbook and 10 -15 other SUB workbooks.

All i am trying to do is copy data from Rows 76 onward till end of the table from the "Records" from all the Sub workbooks in a folder.

I am able to copy the data from all the Sub workbooks but the data comes with a lot of N/A . so if the 1st Sub had 5 records in it, the master would get the 5 records + another 70 rows of N/A and then the rows from the 2nd Sub and the records from that Sub and then a whole lot of N/A.

There must be something in my code that must be doing it. as always i get codes from your forums and other website and try to modify to my needs.
hopefully someone can hel pme.

VBA Code:
Public Sub Consolidate()
    Dim oWB As Workbook
    Dim oSht As Worksheet
    Dim filePath As String
    Dim lastCol As Long
    Dim StrFile As String
    Dim fldr As FileDialog
    Dim strPath As String
    Dim fileCount As Integer
    Dim wsCount As Integer
    Dim shtName As String
    Dim tblCons As ListObject, tblOps As ListObject
    Dim row As Integer
    Dim blnHeaderWritten As Boolean
    Dim MandatoryCol As String
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    
    With fldr
        .Title = "Select a Folder which contains the Files for Consolidating"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        strPath = .SelectedItems(1)
    End With
    
    MandatoryCol = "A"
    
    StrFile = Dir(strPath & "\*.xls*")
    
    
    With ThisWorkbook.Sheets("Records")
    Sheet1.Unprotect
    
     Sheet1.Range("Z:XFD").EntireColumn.Hidden = False
    
        .UsedRange.Offset(76, 0).ClearContents
        lastCol = .Cells(76, Columns.Count).End(xlToLeft).Column
        
        Do While Len(StrFile) > 0
            filePath = strPath & "\" & StrFile
            Set oWB = Workbooks.Open(Filename:=filePath, ReadOnly:=True)
            Set oSht = oWB.Sheets("Records")
            srclastrow = oSht.Cells(Rows.Count, MandatoryCol).End(xlUp).row
            
            If srclastrow > 1 Then
                destlastrow = .Cells(Rows.Count, "A").End(xlUp).row + 1
                
                Set rngSrc = oSht.Range("A76:CU" & srclastrow)
                .Range("A" & destlastrow & ":CU" & srclastrow + destlastrow - 4).Value = rngSrc.Value
                                
            End If
            
            oWB.Close SaveChanges:=False
            If Not oWB Is Nothing Then Set oWB = Nothing
            StrFile = Dir
            Sheet1.Range("Z:XFD").EntireColumn.Hidden = True
        Loop
         Sheet1.Protect
        
        .Activate
        
    End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    MsgBox "Consolidation Completed.", vbInformation
End Sub
 

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,269
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
           If srclastrow > 1 Then
                destlastrow = .Cells(Rows.Count, "A").End(xlUp).row + 1
                
                Set rngSrc = oSht.Range("A76:CU" & srclastrow)
                .Range("A" & destlastrow & ":CU" & destlastrow+rngSrc.Rows.Count).Value = rngSrc.Value
                                
            End If
 

joelmathew

New Member
Joined
Mar 5, 2015
Messages
35
Mate it worked! it still put 1 row of N/aat the bottom of the data from each sheet but i changed your code slightly and it works the first time

VBA Code:
If srclastrow > 1 Then
                destlastrow = .Cells(Rows.Count, "A").End(xlUp).row + 1
                
                Set rngSrc = oSht.Range("A76:CU" & srclastrow)
                .Range("A" & destlastrow & ":CU" & destlastrow+rngSrc.Rows.Count[COLOR=rgb(147, 101, 184)] [B]- 1[/B])[/COLOR].Value = rngSrc.Value
                                
            End If

Thanks a lot. Big all Blacks fan here but Itoje, Curry and Underhill fan!

kind regards
J
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,269
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,269
Messages
5,600,633
Members
414,396
Latest member
rinianjell

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
Top