Copy and Paste Cell From Column A if Cell In Column B Has No Data In It

[Sharid]

I am stuck on this and can not work it out as I CAN NOT get it to copy the cell over from sheet2 to sheet1

What it should Do.
In sheet2 there are 2 columns with data. A & B. Column A has the data in it and B has the word "Done". The code should check Column B to see if it is EMPTY. Then Copy and paste the FIRST cell in A over to Sheet1 B2

The code should copy the word "BookShops" over to Sheet1 B2, once the copy and paste has take place it will place the word "Done" into Sheet2 column B to indicate that this cell has been done.
Therefore the NEXT time the code it run it will copy over the word "Shoe Shops"

The list in Sheet2 Column A will be DYNAMIC

Application.ScreenUpdating = False
    Dim ws As Worksheet
        Set ws = Sheets("Sheet2") '''Sheet2 Column A has Search criteria + column B has the word "Done"
            Dim c  As Range
                For Each c In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row) ''' if column B = "Done" the go to next blank cell
                    If c.Value = "" Then c.Value = c.Offset(, -1).Value ''' if Blank then select cell in Column A
                    ws.Range(ws.Range("A"), ws.Range("A").End(xlUp)).Copy '''Copy Search criteria in A
          Set ws = Sheets("Sheet1") '''Sheet1 Cell B2 is where the coppied data needs to be pasted into from Sheet 2"
                With Sheets("Sheet1") ''' Set sheet1 and pasted coppied data into Sheet1 B2
                    .Select
                    .Range("b2").Select
                    .Paste
                End With
         'Add word "Done" to sheet2 column B, so next time code is run, it will GO TO THE NEXT item as
         'it is looking for the next BLANK cell in column B to copy over.
         ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Offset(RowOffset:=1).Value = "Done"
Application.ScreenUpdating = True

 

[Osvaldo Palmeiro]

Try:

Sub CopyPasteData()
 Cells(Rows.Count, 2).End(3).Offset(1, -1).Copy Sheets("Sheet1").[B2]
 Cells(Rows.Count, 2).End(3)(2) = "Done"
End Sub

 

[Sharid]

I made a small change as the data was on sheet2, other than that super work by Osvaldo Palmeiro

  Application.ScreenUpdating = False
        Dim ws As Worksheet
            Set ws = Sheets("Sheet2")
                ws.Cells(Rows.Count, 2).End(3).Offset(1, -1).Copy Sheets("Sheet1").[B2]
                ws.Cells(Rows.Count, 2).End(3)(2) = "Done"
    Application.ScreenUpdating = True

 

[Sharid]

Although the above code works, I would like it to stop if there is nothing in column A, which it currently does not.

I can Stop and Start a code fine, by adding "Stop" to sheet1 F1

I was trying to get the following to work, so if column A in Sheet2 has no more data in it then it will add the word "Stop" to sheet1 F1 and my code will stop. How ever I can not get it to work

 Application.ScreenUpdating = False
        Dim ws As Worksheet
            Set ws = Sheets("Sheet2")
                If Sheet2.Range("A1:A") Is Empty Then ''' check if column A in sheet2 is empty
                    Sheet1.Range("F1").Value = "Stop"  ''' If empty then add the word "Stop" to sheet1 F1, The code will then stop
                Else
                    ws.Cells(Rows.Count, 2).End(3).Offset(1, -1).Copy Sheets("Sheet1").[B2]
                    ws.Cells(Rows.Count, 2).End(3)(2) = "Done"
                End If
    Application.ScreenUpdating = True

 

[Osvaldo Palmeiro]

Still considering that the Sheet2 will be the active sheet when running the code.

Sub CopyPasteData()
 If Application.CountA([A:A]) = 0 Then Exit Sub
 Cells(Rows.Count, 2).End(3).Offset(1, -1).Copy Sheets("Sheet1").[B2]
 Cells(Rows.Count, 2).End(3)(2) = "Done"
End Sub

 

[Sharid]

Osvaldo

It is not exiting the sub if sheet2 column A has empty row

 

[Fluff]

How about

   With Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
      If .Value <> "" Then
         .Copy Sheets("Sheet1").[B2]
         .Offset(, 1).Value = "Done"
      End If
   End With

 

[Osvaldo Palmeiro]

Sub CopyPasteData()
 If Cells(Rows.Count, 1).End(3).Row <= Cells(Rows.Count, 2).End(3).Row Then Exit Sub
 Cells(Rows.Count, 2).End(3).Offset(1, -1).Copy Sheets("Sheet1").[B2]
 Cells(Rows.Count, 2).End(3)(2) = "Done"
End Sub

 

[Sharid]

Fluff

The Copy and Paste side of BOTH codes are fine, the problem is it does not exit the sub after it is done and is still running. To stop a code I add the word "Stop" to Sheet1 F1 and then this if

 If Sheet1.Range("F1").Value = "Stop" Then
        MsgBox "Process Terminated"
        Exit Sub
    End If

 

[Fluff]

The Copy and Paste side of BOTH codes are fine, the problem is it does not exit the sub after it is done and is still running.

I have no idea what you mean as the code will copy one value only & then quit.