View Single Post
 
Old 05-16-2017, 10:09 AM
jolivanes jolivanes is offline Windows 10 Office 2013
Advanced Beginner
 
Join Date: Sep 2011
Posts: 91
jolivanes will become famous soon enough
Default

I have tried several times to attach a workbook but no luck at all.

I have renamed the first sheet (Spelling)
I have changed the header in Column D (Spelling)

Instead of transferring every time you put an "y" or "Y" somewhere in column E, put an y in Column E in all the rows that need transferring and after you've done them all, click on the "Transfer" button.

You might look into the numbering of the colored cells in Column A. Same numbers might give wrong answers (rows 26 and 27 as well as rows 28 and 29).
You could put an A or B at the end maybe.


Code:
Sub Transfer()
Dim i As Long, a As String
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Deliveries")
Set sh2 = Sheets("Stock")
Application.ScreenUpdating = False
    For i = 2 To sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row
        If sh1.Cells(i, 5).Value = "y" Then
            a = sh1.Cells(i, 1).Value
                sh2.Cells(sh2.Columns(3).Find(a, , , 1).Row, 7).Value = sh1.Cells(i, 5).Offset(, -1).Value
            sh1.Cells(i, 5).Offset(, -1).ClearContents
        End If
    Next i
Application.ScreenUpdating = True
End Sub
Reply With Quote