Copy Ranges from Different Sheets into one Sheet

-Selva V Pasupathy, HSBC Global Resourcing, Hyderabad

  • 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.

HOW SHOULD I USE THE FOLLOWING CODE

Sub CopyRange()
 Dim sh As Worksheet
 Dim DestSh As Worksheet
 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)
 sh.Range("A1:C5").Copy DestSh.Cells(Last + 1, 1)
 End If
 End If
 Next
 Application.ScreenUpdating = True
End Sub

Sub CopyRangeValues()
 Dim sh As Worksheet
 Dim DestSh As Worksheet
 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)
 With sh.Range("A1:C5")
 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

Advertisements

1 Comment »

  1. […] Copy Ranges from Different Sheets into one Sheet […]

RSS feed for comments on this post · TrackBack URI

Leave a Reply

Please log in using one of these methods to post your comment:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: