Help :)

[jcbetanzos]

Hello,

I requested help a few month ago with this code, I was able to find a solution and customized like the following:

Sub Externalabelshn()    '
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    
    Sheets("EXTERNAL LABELS").Activate
    ActiveWorkbook.Unprotect Password:="password"
    ActiveSheet.Unprotect Password:="password"
    
        If Range("B2") = "" Then
            MsgBox "Please add a valid Part Number in cell B2 and try Again"
        Exit Sub
    
        Else
        On Error Resume Next
            Range("E2:H2").Copy Destination:=Range("(E2:H2):E" & Range("B" & Rows.Count).End(xlUp).Row)
        End If
    
    On Error Resume Next
    If Not IsEmpty(ActiveCell.Value) Then
            myLastRow = Range("B2").SpecialCells(xlLastCell).Row
            Range("B2:B" & myLastRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If
    
    ActiveSheet.EnableSelection = xlUnlockedCells
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="password"
    ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:="password"
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    Application.CutCopyMode = False
    
    ActiveWorkbook.Save
    
End Sub

This code is assigned to a button but sometimes (just some weird times) when I run it deletes the all active sheet, any suggestions to avoid this?

 

[Logit]

.
Your original post wherein Fluff provided code suggestions ... you indicated you only wanted to copy data and not delete empty rows/cells.

This somewhat matches your intermittent issues of the entire sheet being cleared.

The only line in your posted code that deletes anything is :

If Not IsEmpty(ActiveCell.Value) Then
            myLastRow = Range("B2").SpecialCells(xlLastCell).Row
            Range("B2:B" & myLastRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If

If you delete those lines of code you will have achieved your original request in the other thread, plus prevent the deletion of any data
in your current project (posted in this thread).