PDA

View Full Version : Solved: Move row to correct sheet if column V = "Y"



4elephants
05-22-2009, 02:48 AM
I have a workbook that has 35 worksheets in it. I have one main data sheet that 12,000 rows are imported into each month. I then have to split the data into one of 34 different worksheets based on the value of column A, but I can only move them if the value in Column V is Y.

I am using this code currently and it works great for moving the data to the right sheet, but i cant seem to be able to code it correctly to check column V for "Y" and just move those rows. Any help you could give me would be gratefully recieved. Thanks in advance.

Sub DistributeData()
Dim i As Long
Dim LastRow As Long
Dim ws As Worksheet
Dim ErrorLog As String
With Sheets("Main")
LastRow = .Range("A65536").End(xlUp).Row
For i = 2 To LastRow
On Error Resume Next
Set ws = Sheets(.Range("A" & i).Text)
On Error GoTo 0
If ws Is Nothing Then
ErrorLog = ErrorLog & vbNewLine & _
"Row:" & i & " Sheet Name: " & .Range("A" & i).Text
Else
.Range("A" & i).EntireRow.Cut _
Destination:=ws.Range("A65536").End(xlUp).Offset(1, 0)
End If
Set ws = Nothing
Next i
End With

If ErrorLog <> "" Then
ErrorLog = "The following worksheets could not be found " & _
"and the data was not transfered over." & vbNewLine & vbNewLine & ErrorLog
MsgBox ErrorLog
End If

Set ws = Nothing

End Sub

Bob Phillips
05-22-2009, 02:57 AM
Sub DistributeData()
Dim i As Long
Dim LastRow As Long
Dim ws As Worksheet
Dim ErrorLog As String

With Sheets("Main")

LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To LastRow

If .Cells(i, "V").Value = "Y" Then

On Error Resume Next
Set ws = Worksheets(.Range("A" & i).Text)
On Error GoTo 0

If ws Is Nothing Then

ErrorLog = ErrorLog & vbNewLine & _
"Row:" & i & " Sheet Name: " & .Range("A" & i).Text
Else

.Range("A" & i).EntireRow.Cut _
Destination:=ws.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
End If

Set ws = Nothing
End If
Next i
End With

If ErrorLog <> "" Then

ErrorLog = "The following worksheets could not be found " & _
"and the data was not transfered over." & vbNewLine & vbNewLine & ErrorLog
MsgBox ErrorLog
End If

Set ws = Nothing

End Sub

4elephants
05-22-2009, 03:12 AM
Thanks for your help XLD, that worked brilliantly.