• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 325
  • Last Modified:

Excel merge sheets

Hello,
Can you please help,
I used below code to merge excel sheets.

- I need to have a pop box to ask me which sheets to merge together.
- The new created sheet to be named as the 2 sheets merged (Example Sheet1 & Sheet2)
- Delete the merged sheets.

Option Explicit
Sub Merge_Sheets()
Sheets.Add After:=Sheets(Sheets.Count)
   Dim wks As Worksheet
   Set wks = Sheets(Sheets.Count)

   wks.Name = "Sheet1 & Sheet2"
   
   With Sheets("Sheet1")
    Dim lastrow As Long
    lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A1:O" & lastrow).Copy wks.Range("A" & wks.Rows.Count).End(xlUp)
   End With

   With Sheets("Sheet2")
    lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A2:O" & lastrow).Copy wks.Range("A" & wks.Rows.Count).End(xlUp).Offset(1)
   End With
   
Application.DisplayAlerts = False
Worksheets("Sheet1").delete
Worksheets("Sheet2").delete

End Sub

any help is appreciated.
Thank you
0
W.E.B
Asked:
W.E.B
  • 2
1 Solution
 
Rgonzo1971Commented:
Hi,

pls try

Option Explicit
Sub Merge_Sheets()
Dim ResultSheet1 As String
Dim ResultSheet2 As String
Dim OrigWks1 As Worksheet
Dim OrigWks2 As Worksheet
Sheets.Add after:=Sheets(Sheets.Count)
   Dim wks As Worksheet
   
   ResultSheet1 = InputBox("What is the first sheet to merge?")
   
   ResultSheet2 = InputBox("What is the second sheet to merge?")
   
   On Error Resume Next
   Set OrigWks1 = ActiveWorkbook.Sheets(ResultSheet1)
   Set OrigWks2 = ActiveWorkbook.Sheets(ResultSheet2)
   On Error Goto 0

   If OrigWks1 Is Nothing Or OrigWks2 Is Nothing Then
        MsgBox "An error occured", vbOKOnly
        Exit Sub
   End If
   
   Set wks = Sheets.Add(after:=Sheets(Sheets.Count))

   wks.Name = ResultSheet1 & " & " & ResultSheet2
   
   With OrigWks1
    Dim lastrow As Long
    lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A1:O" & lastrow).Copy wks.Range("A" & wks.Rows.Count).End(xlUp)
   End With

   With OrigWks2
    lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A2:O" & lastrow).Copy wks.Range("A" & wks.Rows.Count).End(xlUp).Offset(1)
   End With
   
Application.DisplayAlerts = False
OrigWks1.Delete
OrigWks2.Delete
Application.DisplayAlerts = True
End Sub

Open in new window

0
 
W.E.BAuthor Commented:
Hello,
thank you for your help.

it is working, however, it is creating 2 sheets.
one with the merged sheets,
and another empty sheet.

I guess you can't get the pop up message's  for me to enter first sheet and second sheet to merge at same time.

thanks
0
 
W.E.BAuthor Commented:
Thank you very much
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now