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

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,050
Office Version
  1. 2016
Platform
  1. Windows
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
1613303904004.png


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"
1613303967361.png


The list in Sheet2 Column A will be DYNAMIC
VBA Code:
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
 

Some videos you may like

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

Osvaldo Palmeiro

Well-known Member
Joined
Feb 24, 2009
Messages
631
Office Version
  1. 365
Platform
  1. Windows
Try:
VBA Code:
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

Well-known Member
Joined
Apr 22, 2007
Messages
1,050
Office Version
  1. 2016
Platform
  1. Windows
I made a small change as the data was on sheet2, other than that super work by Osvaldo Palmeiro

VBA Code:
  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

Well-known Member
Joined
Apr 22, 2007
Messages
1,050
Office Version
  1. 2016
Platform
  1. Windows
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

VBA Code:
 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

Well-known Member
Joined
Feb 24, 2009
Messages
631
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

VBA 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

Well-known Member
Joined
Apr 22, 2007
Messages
1,050
Office Version
  1. 2016
Platform
  1. Windows
Osvaldo

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

1613316295735.png
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,737
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

How about
VBA Code:
   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

Well-known Member
Joined
Feb 24, 2009
Messages
631
Office Version
  1. 365
Platform
  1. Windows
VBA Code:
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

Well-known Member
Joined
Apr 22, 2007
Messages
1,050
Office Version
  1. 2016
Platform
  1. Windows
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

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

1613318284479.png
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,737
Office Version
  1. 365
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,128,015
Messages
5,628,146
Members
416,294
Latest member
McStuffins

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top