Find next blank line then paste data

T

tynawg

New Member
Joined
Oct 11, 2019
Messages
42
Hi,
On the Service Order tab (Link below) there is a button that runs a macro to extract certain data form the Service Order form then paste to the imported Data sheet.
How can I continue to add different but new data below the last pasted entry in the Imported Data sheet? Code to find next blank row?
Regards,
Wayne


VOID VALIDATION KC.xlsm
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Sort by date Sort by votes
Maybe the below. Just a pointer but you will get more people looking and therefore responding (+ faster) if you post your code in the thread rather than making them download a workbook (a lot of posters won't even download workbooks because of security reasons).
To post your code in the thread all you need to do is copy the code, paste it in the thread then select the code and click the # icon (the last steps put it in code tags).

Code: 
Sub Import_SOR_Data1()
    '
    ' Import_SOR_Data Macro
    st = Timer
    Set ws1 = Sheets("ServiceOrder")
    Set ws2 = Sheets("Imported data")
    
    ws2.Range("A1").Value = ws1.Range("BL3").Value
    ws2.Range("A2").Value = ws1.Range("R16").Value
    
    Application.ScreenUpdating = False
    

    LastRow = ws1.Cells(40, "A").End(xlDown).Row
    lastrow2 = ws2.Cells(Rows.Count, "A").End(xlUp)(2).Row
    
    With ws1
        .Range("a40:a" & LastRow).Copy ws2.Cells(lastrow2, "a")
    
        .Range("p40:p" & LastRow).Copy ws2.Cells(lastrow2, "b")
    
        .Range("ac40:ac" & LastRow).Copy ws2.Cells(lastrow2, "c")
    
        .Range("al40:al" & LastRow).Copy ws2.Cells(lastrow2, "d")
    
        .Range("bk40:bk" & LastRow).Copy ws2.Cells(lastrow2, "e")
       
    End With
    
    For i = 1 To 5
        nr = Choose(i, 11, 11, 8, 55, 20)
        ws2.Columns(i).ColumnWidth = nr
    Next i
    
    ws2.Range("A3").CurrentRegion.Rows.AutoFit

    ws2.Cells.Borders.LineStyle = xlLineStyleNone
    Application.ScreenUpdating = True
    Debug.Print Timer - st                       '0.18 sec
End Sub
 
Last edited:
Upvote 0
THANK you for that, I was wondering why no reply to many questions? I had been talking with one helper and he gt cranky and would only reply if i attached workbooks. I have posted code before and had good responses.
The code has since changes a little trying to capture data from a merged cell format and found 2 lots of code did not copy as each had a column changed but the form appeared the same.
Here is the update;

Code: 
Sub Import_SOR_Data2()
'
' Import_SOR_Data Macro
    st = Timer
    Set ws1 = Sheets("ServiceOrder")
    Set ws2 = Sheets("Imported data")
    
    'ws2.Range("A1").Value = ws1.Range("BL3").Value
    rownr = Cells.Find("Service Order").Row
    colnr = Cells.Find("Service Order").Column
    Cells(rownr + 0, colnr).End(xlToRight).Select

    ws2.Range("A2").Value = ws1.Range("R16").Value
    
    ws1.Select
    lastrow = Cells(40, "A").End(xlDown).Row
    
    colnr = 0 'set this to zero everytime
    colnr = Cells.Find("Trade").Column 'search term must be exact
    Range(Cells(40, colnr), Cells(lastrow, colnr)).Copy   '3 commas, 1 period

    'Range("a40:a" & lastrow).Copy
    ws2.Cells(3, "a").PasteSpecial
    
    'Range("p40:p" & lastrow).Copy
    colnr = 0 'set this to zero everytime
    colnr = Cells.Find("Item Code").Column 'search term must be exact
    Range(Cells(40, colnr), Cells(lastrow, colnr)).Copy   '3 commas, 1 period
    ws2.Cells(3, "b").PasteSpecial
    
    'Range("ac40:ac" & lastrow).Copy
    colnr = 0 'set this to zero everytime
    colnr = Cells.Find("Qty/Hrs").Column 'search term must be exact
    Range(Cells(40, colnr), Cells(lastrow, colnr)).Copy   '3 commas, 1 period
    ws2.Cells(3, "c").PasteSpecial
    
    'ws2.Cells(3, "c").PasteSpecial
    colnr = 0 'set this to zero everytime
    colnr = Cells.Find("Description").Column 'search term must be exact
    Range(Cells(40, colnr), Cells(lastrow, colnr)).Copy   '3 commas, 1 period
    ws2.Cells(3, "d").PasteSpecial
    'Range("al40:al" & lastrow).Copy
    
    'ws2.Cells(3, "d").PasteSpecial
    colnr = 0 'set this to zero everytime
    colnr = Cells.Find("Location/Asset").Column 'search term must be exact
    Range(Cells(40, colnr), Cells(lastrow, colnr)).Copy   '3 commas, 1 period
    ws2.Cells(3, "e").PasteSpecial
    'Range("bk40:bk" & lastrow).Copy
    
    'ws2.Cells(3, "e").PasteSpecial
       
        
    For i = 1 To 5
        nr = Choose(i, 11, 11, 8, 55, 23)
        ws2.Columns(i).ColumnWidth = nr
    Next i
    
    ws2.Range("A3").CurrentRegion.Rows.AutoFit
    ws2.Select
    Cells(1, 1).Select
    Cells.Borders.LineStyle = xlLineStyleNone
    Debug.Print Timer - st                                            '0.18 sec
End Sub
 
Upvote 0
trying to capture data from a merged cell format
Click to expand...
I am afraid that I don't touch anything to do with merged cells so can't help you with that.
 
Upvote 0
Its only the copying to the Imported Data sheet that I would like to know how to set the CopyPaste to be below the last row of existing data.
No question on merged cell copy really. That's another thread.
Regards,
Wayne
 
Upvote 0
Its only the copying to the Imported Data sheet that I would like to know how to set the CopyPaste to be below the last row of existing data.
Click to expand...

The code posted in post number 2 already shows you how to do that.
 
Upvote 0
My bad.
I posted the changed code from the one you posted. So the comparison was not obvious.
I want to apply it to the code I posted if at all possible?
Regards,
Wayne
 
Upvote 0
Your syntax here from post number 3

Code: 
    colnr = Cells.Find("Location/Asset").Column 'search term must be exact
    Range(Cells(40, colnr), Cells(lastrow, colnr)).Copy   '3 commas, 1 period
    [COLOR="#FF0000"]ws2.Cells(3, "e").PasteSpecial[/COLOR]
is the same as in your spreadsheet in post number 1 here

Code: 
    Range("bk40:bk" & lastrow).Copy
    [COLOR="#FF0000"]ws2.Cells(3, "e").PasteSpecial[/COLOR]

and so can be handled in exactly the same way as the code in post number 2

Code: 
 [COLOR="#FF0000"]lastrow2 = ws2.Cells(Rows.Count, "A").End(xlUp)(2).Row[/COLOR]
    
    With ws1
        .Range("a40:a" & LastRow).Copy ws2.Cells(lastrow2, "a")
    
        .Range("p40:p" & LastRow).Copy ws2.Cells(lastrow2, "b")
    
        .Range("ac40:ac" & LastRow).Copy ws2.Cells(lastrow2, "c")
    
        .Range("al40:al" & LastRow).Copy ws2.Cells(lastrow2, "d")
    
        .Range("bk40:bk" & LastRow).Copy [COLOR="#FF0000"]ws2.Cells(lastrow2, "e")[/COLOR]
       
    End With
 
Last edited:
Upvote 0
Hi MARK858,

I can see the process now, thank you.
I have however had to change the code a little since then and wonder if you might have time to assist again?
Also the entire range needs to copy to the next blank ws2, which includes BL2, BL3 and R16?
Regards,
Wayne

Code: 
Sub Import_SOR_Data2()
'
' Import_SOR_Data Macro
    st = Timer
    Application.ScreenUpdating = False
    Dim celA As Range, celB As Range, celC As Range
    Set ws1 = Sheets("ServiceOrder")
    Set ws2 = Sheets("Imported data")
    Set cel = ws2.Range("A1")
    Set celA = ws1.Range("BL3")
    Set celB = ws1.Range("BK3")
 
    If IsNumeric(celA) And celA <> "" Then cel = celA Else cel = celB
    ws2.Range("A2").Value = ws1.Range("R16").Value
    
    ws1.Select
    lastrow = Cells(40, "A").End(xlDown).Row
    
    colnr = 0 'set this to zero everytime
    colnr = Cells.Find("Trade").Column 'search term must be exact
    Range(Cells(40, colnr), Cells(lastrow, colnr)).Copy   '3 commas, 1 period

    ws2.Cells(3, "a").PasteSpecial
    
    colnr = 0 'set this to zero everytime
    colnr = Cells.Find("Item Code").Column 'search term must be exact
    Range(Cells(40, colnr), Cells(lastrow, colnr)).Copy   '3 commas, 1 period
    ws2.Cells(3, "b").PasteSpecial
    
    colnr = 0 'set this to zero everytime
    colnr = Cells.Find("Qty/Hrs").Column 'search term must be exact
    Range(Cells(40, colnr), Cells(lastrow, colnr)).Copy   '3 commas, 1 period
    ws2.Cells(3, "c").PasteSpecial
    
    colnr = 0 'set this to zero everytime
    colnr = Cells.Find("Description").Column 'search term must be exact
    Range(Cells(40, colnr), Cells(lastrow, colnr)).Copy   '3 commas, 1 period
    ws2.Cells(3, "d").PasteSpecial
   
    colnr = 0 'set this to zero everytime
    colnr = Cells.Find("Location/Asset").Column 'search term must be exact
    Range(Cells(40, colnr), Cells(lastrow, colnr)).Copy   '3 commas, 1 period
    ws2.Cells(3, "e").PasteSpecial
        
    For i = 1 To 5
        nr = Choose(i, 11, 11, 8, 55, 23)
        ws2.Columns(i).ColumnWidth = nr
    Next i
    
    ws2.Range("A3").CurrentRegion.Rows.AutoFit
    ws2.Select
    Cells(1, 1).Select
    Cells.Borders.LineStyle = xlLineStyleNone
    Application.ScreenUpdating = True
    Debug.Print Timer - st                                            '0.18 sec
End Sub
 
Upvote 0
Post number 8 shows you how to post to the next row.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
vba code to give next Sunday date for pasted data
Replies
2
Views
180
bh24524
B
G
  • Solved
Loop with column header match and two conditions paste
Replies
3
Views
423
Legacy 143009
L
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
1
Views
203
bobaol
B
U
  • Question
Information overwriting when transferring
Replies
7
Views
255
UTB
U
N
  • Question
find data containing key words
2
Replies
11
Views
283
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,214,819
Messages
6,121,746
Members
449,050
Latest member
excelknuckles

Share this page

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
Back
Top