Copy from row till the last row with data into one sheet using VBA in Microsoft Excel

  •  The macro will add a sheet with the name Master to your workbook and will copy the cells from every sheet in your workbook in this worksheet.
  • The first macro does a normal copy and the second macro copy the Values.
  • The macro's subs use the functions below, the macro's won’t work without the functions.
Sub CopyFromRow()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim shLast As Long
    Dim Last As Long
    If SheetExists("Master") = True Then
        MsgBox "The sheet Master already exist"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set DestSh = Worksheets.Add
    DestSh.Name = "Master"
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then
            If sh.UsedRange.Count > 1 Then
                Last = LastRow(DestSh)
                shLast = LastRow(sh)
                sh.Range(sh.Rows(3), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, 1)
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Sub CopyFromRowValues()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim shLast As Long
    Dim Last As Long
    If SheetExists("Master") = True Then
        MsgBox "The sheet Master already exist"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set DestSh = Worksheets.Add
    DestSh.Name = "Master"
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then
            If sh.UsedRange.Count > 1 Then
                Last = LastRow(DestSh)
                shLast = LastRow(sh)
                With sh.Range(sh.Rows(3), sh.Rows(shLast))
                    DestSh.Cells(Last + 1, 1).Resize(.Rows.Count, _
                    .Columns.Count).Value = .Value
                End With
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

Function Lastcol(sh As Worksheet)
    On Error Resume Next
    Lastcol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function
Function SheetExists(SName As String, _
                     Optional ByVal WB As Workbook) As Boolean
     On Error Resume Next
    If WB Is Nothing Then Set WB = ThisWorkbook
    SheetExists = CBool(Len(Sheets(SName).Name))
End Function

Leave a Reply

Your email address will not be published. Required fields are marked *

Terms and Conditions of use

The applications/code on this site are distributed as is and without warranties or liability. In no event shall the owner of the copyrights, or the authors of the applications/code be liable for any loss of profit, any problems or any damage resulting from the use or evaluation of the applications/code.