Transfer data but not rows with a certain blank cell

[UTB]

Hi All,

I am in the middle of a doing a spreadsheet that involves a number of worksheets and transferring data between them based on certain info at the click of a button.

I have managed to muddle my way through VBA to pretty much get it to do what I want.

However, I am seeking to change some of the VBA Code to iron out and streamline it a bit better and for the life of me I cannot get my head around how to make the amendment to the code I already have to improve what I want.

Below is what I currently have. It worked for a while until I realised it could do better and was causing more work than intended when I click a button to transfer data across when I have allocated some work. (Moves everything down to Row 25 regardless when I don’t want it to move data when I have not allocated a job and I am limited to only down to row 25 when I’d prefer it to scan the entire worksheet if that makes sense??)

Sub Button2_Click()
'Set variables
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim iSourceLastRow As Long
Dim iTargetLastRow As Long
'Set variables for source and destination sheets
Set wsSource = Worksheets("Awaiting")
Set wsTarget = Worksheets("Allocated Work")
'Find last used row in the source sheet based on data in column A
iSourceLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
'Find first blank row in the destination sheet based on data in column A
'Offset property is to move the copied data 1 row down
iTargetLastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1).Row
'Copy data from the source and Paste in the destination
wsSource.Range("A3:Q25" & iSourceLastRow).Copy wsTarget.Range("A" & iTargetLastRow)

What I am wanting to do is rather than the basic A3:Q25 range, I am trying to move anything wherever there is any text in Column B to the worksheet known as “Allocated Work” and leave data/rows in the “Awaiting”where Column B is blank (awaiting a name for allocation).

Additionally, I only want to move the information in a row up to Column Q (as per my original code rather than the entire row….if that makes sense and hopefully this will also remove the need for me to put in a range down to Row 25 (my coding is very basic as you can see as I’d just want the code to scan the entire worksheet but again didn’t know how to do that)

I hope that makes sense and if not, please ask for clarification and I will do my best to explain better.

Very grateful and thank you in advance for any assistance.

 

[NoSparks]

declare a variable as Range, cel is used here. It is used for each range of one cell in the column.
then replace this

    wsSource.Range("A3:Q25" & iSourceLastRow).Copy wsTarget.Range("A" & iTargetLastRow)

with

    For Each cel In wsSource.Range("B3:B" & iSourceLastRow)
        If Not IsEmpty(cel) Then
            cel.Offset(, -1).Resize(1, 17).Copy wsTarget.Range("A" & iTargetLastRow)
            iTargetLastRow = iTargetLastRow + 1
        End If
    Next cel

hope that helps

 

[UTB]

declare a variable as Range, cel is used here. It is used for each range of one cell in the column.
then replace this

    wsSource.Range("A3:Q25" & iSourceLastRow).Copy wsTarget.Range("A" & iTargetLastRow)

with

    For Each cel In wsSource.Range("B3:B" & iSourceLastRow)
        If Not IsEmpty(cel) Then
            cel.Offset(, -1).Resize(1, 17).Copy wsTarget.Range("A" & iTargetLastRow)
            iTargetLastRow = iTargetLastRow + 1
        End If
    Next cel

hope that helps

That worked a treat.

Thanks for your assistance. I had been playing around in that code for a while trying to get it to do what you’ve achieved (although I admit my knowledge is only very basic as demonstrated haha!).

Thanks once again.