• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 318
  • 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

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

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