VBA-code shall not delete

KlausW

Active Member
Joined
Sep 9, 2020
Messages
385
Office Version
  1. 2016
Platform
  1. Windows
Hi
I found this VBA code on the internet, it does what I need.
The only thing I do not want it to do is that when I run the code, it deletes the entire sheet, it must not delete anything.

All help will be appreciated

Best regards Klaus W.

VBA Code:
Sub Rektangelafrundedehjørner1_Klik()

'Procedure to Consolidate all sheets in a workbook

On Error GoTo IfError

'1. Variables declaration

Dim Sht As Worksheet, DstSht As Worksheet

Dim LstRow As Long, LstCol As Long, DstRow As Long

Dim i As Integer, EnRange As String

Dim SrcRng As Range

'2. Disable Screen Updating - stop screen flickering

' And Disable Events to avoid inturupted dialogs / popups

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

'3. Delete the Consolidate_Data WorkSheet if it exists

Application.DisplayAlerts = False

On Error Resume Next

ActiveWorkbook.Sheets("Consolidate_Data").Delete

Application.DisplayAlerts = True

'4. Add a new WorkSheet and name as 'Consolidate_Data'

With ActiveWorkbook

Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))

DstSht.Name = "Consolidate_Data"

End With

'5. Loop through each WorkSheet in the workbook and copy the data to the 'Consolidate_Data' WorkSheet

For Each Sht In ActiveWorkbook.Worksheets

If Sht.Name <> DstSht.Name Then

'5.1: Find the last row on the 'Consolidate_Data' sheet

DstRow = fn_LastRow(DstSht)

'5.2: Find Input data range

LstRow = fn_LastRow(Sht)

LstCol = fn_LastColumn(Sht)

EnRange = Sht.Cells(LstRow, LstCol).Address

Set SrcRng = Sht.Range("a2:" & EnRange)

'5.3: Check whether there are enough rows in the 'Consolidate_Data' Worksheet

If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then

MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."

GoTo IfError

End If

'5.4: Copy data to the 'consolidated_data' WorkSheet

SrcRng.Copy Destination:=DstSht.Range("k" & DstRow + 1)

End If

Next

'DstSht.Range("A1") = "You can place the headeing in the first row"

IfError:

'6. Enable Screen Updating and Events

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
So why not just remove this line of the code:
ActiveWorkbook.Sheets("Consolidate_Data").Delete
 
Upvote 0
It looks like it deletes the sheet and then creates a new sheet with the same name.
So it looks like this script wants to consolidate all sheets in the workbook to a single sheet is that what you want?

In your code:
'Procedure to Consolidate all sheets in a workbook
 
Upvote 0
It looks like it deletes the sheet and then creates a new sheet with the same name.
So it looks like this script wants to consolidate all sheets in the workbook to a single sheet is that what you want?

In your code:
'Procedure to Consolidate all sheets in a workbook
Yes but without deleting the the formulas in the sheets where I consolidate sheets to
 
Upvote 0
When I do, Excel makes an extra sheet. And I do not want that. KW
What is your overall objective? the script deletes the sheet and then creates a new one with same name so as to start a fresh. So your not really adding a new sheet it deletes one and then adds a new sheet
 
Upvote 0
So delete the line of code where it deletes the sheet and delete the line of code where it creates the new sheet.
But I would think trying to consolidate all sheets into one sheet and still keep all formulas may be difficult. Depending on the formulas.
 
Upvote 0
What is your overall objective? the script deletes the sheet and then creates a new one with same name so as to start a fresh. So your not really adding a new sheet it deletes one and then adds a new sheet
I want to consolidate it into the same sheets every time, I do not want the old one to be deleted and a new one created.
 
Upvote 0
I want to consolidate it into the same sheets every time, I do not want the old one to be deleted and a new one created.
So try to modify the code like I said and see what happens.
Delete the line of code that deletes the sheet and delete the line of code that creates the new sheet. But again trying to keep all the formulas doing what they should do might be difficult depending on the formulas.

Like in sheet(5) the formula might be ="A1"
But when consolidated now A1 in the consolidated sheet will no longer be the same.



Bu
 
Upvote 0
I have deleted these lines and try but noting happen. I send the code. Can U help.

VBA Code:
'3. Delete the Consolidate_Data WorkSheet if it exists

'Application.DisplayAlerts = False

'On Error Resume Next

'ActiveWorkbook.Sheets("Consolidate_Data").Delete

'Application.DisplayAlerts = True

'4. Add a new WorkSheet and name as 'Consolidate_Data'

'With ActiveWorkbook

'Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))

'DstSht.Name = "Consolidate_Data"

'End With
 
Upvote 0

Forum statistics

Threads
1,215,214
Messages
6,123,660
Members
449,114
Latest member
aides

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
Back
Top