» 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:
- Quantitative Methods in Derivatives Pricing: An Introduction to Computational Finance
- The Intelligent Investor: The Classic Bestseller on Value Investing
- The 22 Immutable Laws of Marketing : Exposed and Explained by the World's Two
- Microsoft Office Xp: Advanced Concepts and Techniques: Word 2002, Excel 2002, Access 2002, Powerpoint 2002
- Word 2002: The Complete Reference
- Financial Statements: A Step-By-Step Guide to Understanding and Creating Financial Reports
No comments have been submitted.

