Copying data from mutiple workbooks to one workbook

[joelmathew]

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.

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

 

[Fluff]

How about

           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]

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

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]

You're welcome & thanks for the feedback.