Excel VBA: Delete and Merge Sheets

MLCR

New Member
Joined
Sep 24, 2020
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
Hi, I am a beginner in Excel VBA.

When I download an Excel report from my accounting system, it generates 2 extra empty sheets called "Sheet2" and "Sheet3". I only need "Sheet1". This repeats for all other 10 reports that I download from the system. What I need to do is to delete "Sheet2" and "Sheet3" from every downloaded report and combine these 10 reports into a single workbook. I have managed to find this merging workbooks VBA (see below). But am wondering how can I add in the step to delete "Sheet2" and "Sheet3"?

Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = Environ("userprofile") & "DesktopTest"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub


I am open to other VBA code as well. Thanks!!
 

Some videos you may like

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.

drsarao

Well-known Member
Joined
Sep 9, 2009
Messages
1,143
Office Version
  1. 2007
Platform
  1. Windows
No need to delete. Just DON'T copy them into your consolidated workbook. (You don't need the downloaded file anymore I presume)

VBA Code:
Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = Environ("userprofile") & "DesktopTest"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
    Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
    For Each Sheet In ActiveWorkbook.Sheets
        If Sheet.Name <> "Sheet2" And Sheet.Name <> "Sheet3" Then
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
        End If
    Next Sheet
    Workbooks(Filename).Close
    Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub
 

MLCR

New Member
Joined
Sep 24, 2020
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
It works! Thank you so much, really appreciate it!

Is it possible to include in VBA code different names for "Sheet1"?

Because when I do it manually, I will rename "Sheet1" to "ALI Aug20" and then remove "Sheet2" and "Sheet3".

On another report, I will rename the "Sheet1" to "PO Aug20" and remove the other 2 sheets.

In total, would have 10 of these to rename.
 

drsarao

Well-known Member
Joined
Sep 9, 2009
Messages
1,143
Office Version
  1. 2007
Platform
  1. Windows
Try this:
VBA Code:
Sub ConslidateWorkbooks()

Dim FolderPath As String

Dim Filename As String

Dim pfx() As String, sfx As String

Dim Sheet As Worksheet

Application.ScreenUpdating = False

FolderPath = Environ("userprofile") & "DesktopTest"

Filename = Dir(FolderPath & "*.xls*")

pfx = Array("PO", "ALI", "xx", "xxx", "yyy") 'array for prefixes - as needed

sfx = "Aug20" 'suffix

p = 1

Do While Filename <> ""

    Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True

    For Each Sheet In ActiveWorkbook.Sheets

        If Sheet.Name <> "Sheet2" And Sheet.Name <> "Sheet3" Then

            Sheet.Name = pfx(p) & sfx

            Sheet.Copy After:=ThisWorkbook.Sheets(1)

            p = p + 1

        End If

    Next Sheet

    Workbooks(Filename).Close

    Filename = Dir()

Loop

Application.ScreenUpdating = True

End Sub
populate pfx array as per your requirement for 10 sheets
I havent tested the code.
possible errors:
Excel doesn't tolerate duplicate sheet names.
pfx array should have enough (10) names or out of subscript error
 

MLCR

New Member
Joined
Sep 24, 2020
Messages
6
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Ok, will try, thank you!
 

MLCR

New Member
Joined
Sep 24, 2020
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
Hi @drsarao, I'm facing the "run-time error '13': type mismatch error" when I added in the lines of codes for pfx and sfx.

VBA Code:
Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim pfx() As String, sfx As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = Environ("userprofile") & "DesktopTest"
Filename = Dir(FolderPath & "*.xls*")
pfx = Array("ALI", "Program-1", "Program-2", "Program-3", "PO", "Notes") 'array for prefixes - as needed
sfx = "Aug20" 'suffix
p = 1
Do While Filename <> ""
    Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
    For Each Sheet In ActiveWorkbook.Sheets
        If Sheet.Name <> "Sheet2" And Sheet.Name <> "Sheet3" Then
            Sheet.Name = pfx(p) & sfx
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
            p = p + 1
        End If

    Next Sheet
    Workbooks(Filename).Close
    Filename = Dir()
Loop

Application.ScreenUpdating = True

End Sub

I checked and the error occurs because of incompatible data types? Thank you!
 

drsarao

Well-known Member
Joined
Sep 9, 2009
Messages
1,143
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

Dim pfx() without type declaration solves it. It actually declares the array as variant. And allows to store strings. Go figure.
Counter p has to start at 0 because this is 0 based array (Unless you declared "Option Base 1")
VBA Code:
Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim pfx(), sfx As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = Environ("userprofile") & "DesktopTest"
Filename = Dir(FolderPath & "*.xls*")
pfx = Array("ALI", "Program-1", "Program-2", "Program-3", "PO", "Notes") 'array for prefixes - as needed
sfx = "Aug20" 'suffix
p = 0
Do While Filename <> ""
    Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
    For Each Sheet In ActiveWorkbook.Sheets
        If Sheet.Name <> "Sheet2" And Sheet.Name <> "Sheet3" Then
            Sheet.Name = pfx(p) & sfx
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
            p = p + 1
        End If
    Next Sheet
    Workbooks(Filename).Close
    Filename = Dir()
Loop

Application.ScreenUpdating = True

End Sub

Instead of hard coding pfx and sfx, you can pick them off the master worksheet.
eg
pfx=worksheets("Master").Range("Z1:Z10")
sfx=worksheets("Master").Range("Y1")
 

Watch MrExcel Video

Forum statistics

Threads
1,122,472
Messages
5,596,354
Members
414,060
Latest member
hermanseck

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top