» Copy from row till the last row with data into one sheet using VBA in Microsoft Excel
VBA macro tip contributed by Ron de Bruin, Microsoft MVP - Excel
CATEGORY - Cells, Ranges, Rows, and Columns in VBA
VERSION - All Microsoft Excel Versions
- 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
Book Store:
Recommended Books:
No comments have been submitted.

