copy to vba

[billandrew]

good evening

trying to copy all values (numbers 1 through 4) in column e to a new appropriate worksheet. For some reason not all data is copied over.

There are many spaces between rows, do not believe this is the reason? Used this code before, no issue in past.

Any help would be appreciated


Code using.

Dim i As Long
Dim lastrow As Long
Dim lastrow2 As Long
Dim sh As string
Sheets("Sheet2A").Activate



Application.ScreenUpdating = False


lastrow = Sheets("Sheet2A").Range("E" & Rows.Count).End(xlUp).Row

For i = 2 To lastrow
If Cells(i, "E").Value <> "" Then
result = Cells(i, "E").Value
Sheets("Sheet2A").Rows(1).Copy Destination:=Sheets(sh).Rows(1)


lastrow2 = Sheets(sh).Cells(Rows.Count, "A").End(xlUp).Row + 1

Rows(i).Copy Destination:=Sheets(sh).Rows(lastrow2)



End If

Next i


Application.ScreenUpdating = True

Exit Sub




End Sub

 

[Joe4]

Not really sure what you are trying to do. You have a lot of weird stuff going on.

What is "sh"?
You are using it, but never defined it.

What are you defined "result", but then never using it?

Why is this row inside your loop?

[COLOR=#333333]Sheets("Sheet2A").Rows(1).Copy Destination:=Sheets(sh).Rows(1)[/COLOR]

That is copying over row 1 repeatedly.

 

[billandrew]

Bad attempt to copy all data in column e if meets a certain criteria place it on the proper worksheet. i.e If value in column e is a 1 place it on sheet name 1. There are 4 criteria. 1 to 4.

 

[billandrew]

This is revised code, however does not copy all the data over to the appropriate sheet.

Dim i As Long
Sheets("Sheet2").Activate
Dim Lastrow As Long
Lastrow = Sheets("Sheet2").Cells(Rows.Count, "E").End(xlUp).Row
Dim Lastrow2 As Long
Dim result As String



For i = 2 To Lastrow

If Cells(i, "E").Value <> "" Then
result = Cells(i, "E").Value
Sheets("Sheet2").Rows(1).Copy Destination:=Sheets(result).Rows(1)





Lastrow2 = Sheets(result).Cells(Rows.Count, "E").End(xlUp).Row + 1

Rows(i).Copy Destination:=Sheets(result).Rows(Lastrow2)

Sheets(result).Columns("a:e").EntireColumn.AutoFit
End If
Next

Sheets("Sheet2").Cells(1, 1).Select

Application.ScreenUpdating = True
Exit Sub




End Sub

 

[Joe4]

Have the you thought about using Filters, to filter out just what you want, and move that to your new sheet?
See the "Extract Data to Another Location" section here: http://www.contextures.com/xladvfilter01.html

If you want VBA code, you can use the Macro Recorder, you can record yourself performing these steps and get a lot of the VBA code you need.
That will give you a good starting point.

 

[Joe4]

If you want to use loops like you were trying to do initially (note that loops are usually inefficient, so if you have a lot of data, they may be slow), here is how you can clean up your code to work:

Sub MyMacro()

    Dim i As Long
    Dim Lastrow As Long
    Dim Lastrow2 As Long
    Dim result As String

    Application.ScreenUpdating = False

    Sheets("Sheet2").Activate
    Lastrow = Sheets("Sheet2").Cells(Rows.Count, "E").End(xlUp).Row

    For i = 2 To Lastrow
        If Cells(i, "E").Value <> "" Then
            result = Cells(i, "E").Value
            If Sheets(result).Range("E1") = "" Then
                Sheets("Sheet2").Rows(1).Copy Destination:=Sheets(result).Rows(1)
            End If
            Lastrow2 = Sheets(result).Cells(Rows.Count, "E").End(xlUp).Row + 1
            Sheets("Sheet2").Rows(i).Copy Destination:=Sheets(result).Rows(Lastrow2)
            Sheets(result).Columns("A:E").EntireColumn.AutoFit
        End If
    Next i

    Sheets("Sheet2").Cells(1, 1).Select

    Application.ScreenUpdating = True

End Sub

 

[billandrew]

I have a break at line

If sheets(result).range("E1")="" then

 

[Joe4]

Did you place that break there?
Or are you saying that you are getting an error?
If so, what is the error message?
If you hover over the word "result", what does it show as its value when the error occurs?
Do you have a sheet by that name?

 

[billandrew]

I did not place the break
error is Run Time error 9
result = 11
Yes there is a sheet by this name in the workbook

The code does run after I debug, however not all the data is copied over


Thank You

 

[Joe4]

Yes there is a sheet by this name in the workbook

Excel disagrees.

They need to match EXACTLY. Look for any extra spaces in the sheet name or in cell E11.