Copying rows into master sheet

Viewed 41

I have a workbook that will be getting updated daily by different users across the country. at intervals i will need to copy all data inputted on the different sheets for each site onto a master sheet for HQ. I've tried writing myself and really dont have alot of experience with VBA. i've tried a few other examples on other threads but cant find any that are quite right for mine. I want it to copy onto a master but then if more data gets added the next day, when it copies the next time it dosnt copy whats already been copied. Ideally i need the master to have all the various sites data collated but still keep it all in the original sheets too. Looking at this one i think its the closest i can find to what i'm trying to do but i keep getting runtime errors. I dont claim to understand this by any means.

Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long




Set wksDst = ThisWorkbook.Worksheets("Master data")
lngDstLastRow = LastOccupiedRowNum(wksDst)
lngLastCol = LastOccupiedColNum(wksDst)


Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)


For Each wksSrc In ThisWorkbook.Worksheets

    
   If wksSrc <> "National tasks" And wksSrc <> "Sheet8" And wksSrc <> "Master data" Then
        
        
        lngSrcLastRow = LastOccupiedRowNum(wksSrc)
        
        
        With wksSrc
            Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol))
            rngSrc.Copy Destination:=rngDst
        End With
        
        
        lngDstLastRow = LastOccupiedRowNum(wksDst)
        Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
        
    End If

Next wksSrc

End Sub

Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row
        End With
    Else
        lng = 1
    End If
    LastOccupiedRowNum = lng
End Function


Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByColumns, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Column
        End With
    Else
        lng = 1
    End If
    LastOccupiedColNum = lng
End Function
1 Answers

This is how I would do it without separate functions. Notice where in the loop we check for last rows, after the End if and before the Next

Sub CopyData()
    Dim wksSrc As Worksheet
    Dim wksDst As Worksheet
    Dim rngSrc As Range
    Dim DstLastCol As Long
    Dim SrcLastCol As Long
    Dim SrcLastRow As Long
        
    Set wksDst = ThisWorkbook.Worksheets("Master data")
    DstLastRow = wksDst.Cells(Rows.Count, 1).End(xlUp).Row
    
    For Each wksSrc In ThisWorkbook.Worksheets
    
       If wksSrc.Name <> "National tasks" And wksSrc.Name <> "Sheet8" And wksSrc.Name <> "Master data" Then
            SrcLastRow = wksSrc.Cells(Rows.Count, 1).End(xlUp).Row
            SrcLastCol = wksSrc.Cells(1, Columns.Count).End(xlToLeft).Column
               
            With wksSrc
                Set rngSrc = .Range(.Cells(2, 1), .Cells(SrcLastRow, SrcLastCol))
                rngSrc.Copy Destination:=wksDst.Cells(DstLastRow + 1, 1)
            End With
            
        End If
        
        DstLastRow = wksDst.Cells(Rows.Count, 1).End(xlUp).Row

    Next wksSrc

End Sub
Related