Hi all,
Complete VBA novice here and i have been trying this for a few days and have finally succumbed to all the greatness on here.
I have a workbook = Sales Sheet 1
Within the workbook are Multiple Sheets
I want a VBA code that will merge three specific sheets into an existing sheet.
I am using Excel 2013 and have the following code so far which i got from a link that was posted on here previously Merge cells from all or some worksheets into one Master sheet
The code i am using is picking all the sheets, however i only want it to copy from the following sheets: "Mike" "Conor" "Kris".
It is also picking up the headers on the sheets which i dont want.
And finally is placing it into a new sheet called "NewSummary", i want the data to be pasted into an already existing sheet called "Summary", where i have the headers so it must be placed starting from Row 2.
Can anyone please help? Please go easy on me.
Thanks in advance.
The code i am using - and yes i realize its probably completely wrong and has hints all the way through it is here:
Complete VBA novice here and i have been trying this for a few days and have finally succumbed to all the greatness on here.
I have a workbook = Sales Sheet 1
Within the workbook are Multiple Sheets
I want a VBA code that will merge three specific sheets into an existing sheet.
I am using Excel 2013 and have the following code so far which i got from a link that was posted on here previously Merge cells from all or some worksheets into one Master sheet
The code i am using is picking all the sheets, however i only want it to copy from the following sheets: "Mike" "Conor" "Kris".
It is also picking up the headers on the sheets which i dont want.
And finally is placing it into a new sheet called "NewSummary", i want the data to be pasted into an already existing sheet called "Summary", where i have the headers so it must be placed starting from Row 2.
Can anyone please help? Please go easy on me.
Thanks in advance.
The code i am using - and yes i realize its probably completely wrong and has hints all the way through it is here:
Rich (BB code):
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
Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Delete the summary sheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True
' Add a new summary worksheet.
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "NewSummary"
' Fill in the start row.
StartRow = 2
' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
' Find the last row with data on the summary worksheet.
Last = LastRow(DestSh)
' Specify the range to place the data.
Set CopyRng = sh.UsedRange
' Test to see whether there are enough rows in the summary
' worksheet to copy all the data.
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the " & _
"summary worksheet to place the data."
GoTo ExitTheSub
End If
' This statement copies values and formats from each
' worksheet.
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
' AutoFit the column width in the summary sheet.
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub