Macro not deleting zero values from new sheet.

[ghrek]

Hi

I have this macro and it copies and pastes to the new sheet but does not vopy new values into column Y and delete the zero values from the new sheet.

Any Ideas?

Option Explicit

Sub TransferData()
Dim lngLastRow As Long
Dim lngRow As Long
Dim strSheetName As String
Dim wsSource As Worksheet

lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set wsSource = ActiveSheet

With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

strSheetName = InputBox("Please enter the name of the new worksheet", "Transfer Data")
If StrPtr(strSheetName) = 0 Then
    MsgBox "No worksheet name entered"
    Exit Sub
End If

 

[HaHoBe]

Hi ghrek,

the code you published is sort of an unfinished symphony - it's incomplete.

Ciao,
Holger

 

[ghrek]

I thought it was but not got a clue where to go from here.

Any ideas

Thanks

 

[HaHoBe]

Hi ghrek,

maybe start with showing the complete code? There is no code dealing with deleting any values...

Holger

 

[ghrek]

Apologies... Here goes

Option Explicit

Sub TransferData()
Dim lngLastRow As Long
Dim lngRow As Long
Dim strSheetName As String
Dim wsSource As Worksheet

lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set wsSource = ActiveSheet

With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

strSheetName = InputBox("Please enter the name of the new worksheet", "Transfer Data")
If StrPtr(strSheetName) = 0 Then
    MsgBox "No worksheet name entered"
    Exit Sub
End If

Sheets.Add(After:=Sheets(Sheets.Count)).Name = strSheetName
wsSource.Range("A1:Y" & lngLastRow).Copy
With ActiveSheet
    .Range("A1").PasteSpecial
    .Range("G10:Y" & lngLastRow).Clear
    For lngRow = lngLastRow To 1 Step -1
        If Not IsEmpty(.Cells(lngRow, "Y")) Then
            If .Cells(lngRow, "Y") = 0 Then
                .Cells(lngRow, "Y").EntireRow.Delete
            End If
        End If
    Next
End With

With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With


End Sub

 

[HaHoBe]

Hi ghrek,

if you apply the codeline

    .Range("G10:Y" & lngLastRow).Clear

the loop for Column Y should be restricted to

    For lngRow = 10 To 1 Step -1

I wonder why you use PasteSpecial as no XlPasteSpecialOperation-Enumeration is mentioned.

Holger

 

[HaHoBe]

Hi ghrek.

as Y10 is empty the loop should start with 9 instead of 10. On my testbook everything wokrs like I expect it to be but this might be due to the simple formulas I choose to test.

Holger

 

[ghrek]

Many thanks