Macro is not copying over data correctly.

[ghrek]

Hi

I have this macro thats supposed to ask me for a new sheet name ( which it does) , Copy over the data to the new sheet and this is where it goes wrong.

As stated it copies the data over to the new sheet but only in all columns 1-9 as there is data in them rows. Im trying to copy everything even if there is no data in the cells as then its not deleting rows fully.

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

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

 

[rollis13]

wsSource.Range("A1:Y" & lngLastRow).Copy

Here you are copying range A:Y to last row, why di you say it was only columns 1-9 ?

With ActiveSheet .Range("A1").PasteSpecial

Here you paste from cell A1. This looks okay.

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

Then you clear the range only from G10 to Y lastrow. This too seems okay.

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

Now you are looping, from last row to top, on column Y and checking if the cells in column Y are not empty; if they are not empty you then check if the cell's value and only if it is 0 you are deleting the entire row.
Is this what you are supposted to be doing ?

 

[ghrek]

Here you are copying range A:Y to last row, why di you say it was only columns 1-9 ?
Here you paste from cell A1. This looks okay.
Then you clear the range only from G10 to Y lastrow. This too seems okay.
Now you are looping, from last row to top, on column Y and checking if the cells in column Y are not empty; if they are not empty you then check if the cell's value and only if it is 0 you are deleting the entire row.
Is this what you are supposted to be doing ?

AAAHHHHHH

Think I may of found answer. If I am reading your reply right I think the issue is .Range("G10:Y" & lngLastRow).Clear

Its clearing the range from G10 to Y last row and then looking for the zero values? I only need it to delete the entire row if the value in a cell of column Y is zero.

How do I get round that?

 

[rollis13]

Well, it seems to me that all you have to do is get rid of that line; so rem the line .Range("G10:Y" & lngLastRow).Clear and have another try.