VBA - Past data from one worksheet to another - And next empty row.

Masimo85

New Member
Joined
Jun 5, 2020
Messages
15
Office Version
  1. 365
Platform
  1. Windows
Hi,


So, I’m struggling here with a macro that I supposed to Copy a range of Cells A6 to AJ6
From one sheet to another.

However, on the next sheet it should find the next empty row from row 18-32.
And say that data in a row is later deleted, the next entry will find that row and fill in the data here, instead of continuously going downwards.

The macro im working with looks like this:

Sub Legg_til_Innkjøp()

Worksheets("Innkjøp").Range("A18").FormulaR1C1 = "=TODAY()"

Worksheets("Lagerstatus").Unprotect Password:="Norskmodul123"

Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim lr As Long

Set copySheet = Worksheets("Innkjøp")
Set pasteSheet = Worksheets("Lagerstatus")

copySheet.Range("A6:AJ6").Copy
lr = pasteSheet.Range("A18").End(xlDown).Row
pasteSheet.Range("A" & lr + 1).PasteSpecial xlValues
Application.CutCopyMode = False

Worksheets("Lagerstatus").Protect Password:="Norskmodul123"

Range("A6:AJ6").ClearContents

End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,141
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
What do you want to happen if all the cells in row 18-32 are filled?
 

Masimo85

New Member
Joined
Jun 5, 2020
Messages
15
Office Version
  1. 365
Platform
  1. Windows
What do you want to happen if all the cells in row 18-32 are filled?
Hei Mark858,

In that rare case it could just continue down - the rows going from 18-32 was just an example - and the rows below that point would always be empty.

However, I highly doubt that would ever be the case.
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,141
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
When does the code that you posted not do that, End(xlDown) always finds the last cell with data before a blank cell each time it is run as long as the cell is truly blank (i.e. no formula returning "", spaces or any other character in the cell)?
Are you really trying to find the first blank cell after all your data in the column?
 

Masimo85

New Member
Joined
Jun 5, 2020
Messages
15
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Hi again,

I guess a few pictures might explain this better - so the copy sheet looks like this:

1620147146578.png


And the paste sheet looks like this:

1620147188030.png


As of now the macro dosnt do anything I just get an error:

1620147234593.png



I nva got it to work, so I in regards to find an empty cell.
Was just making sure I didnt get a "Fixed" makro back, that would continue down the rows ;)
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,141
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
You are getting the error there because there are no filled cells in the range so xldown is finding cell B1048576 (the last cell in the column) and the + 1 takes it off the sheet.

Try
VBA Code:
Sub Legg_til_Innkjøp()

    Worksheets("Innkjøp").Range("A18").FormulaR1C1 = "=TODAY()"

    Worksheets("Lagerstatus").Unprotect Password:="Norskmodul123"

    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet
    Dim lr As Long

    Set copySheet = Worksheets("Innkjøp")
    Set pasteSheet = Worksheets("Lagerstatus")

    copySheet.Range("A6:AJ6").Copy
    lr = pasteSheet.Range("B" & Rows.Count).End(xlUp).Row
    If lr < 17 Then lr = 17
    pasteSheet.Range("A" & lr + 1).PasteSpecial xlValues

    Application.CutCopyMode = False

    Worksheets("Lagerstatus").Protect Password:="Norskmodul123"

    Range("A6:AJ6").ClearContents

End Sub

Please can you also use code tags when posting code
 
Solution

Masimo85

New Member
Joined
Jun 5, 2020
Messages
15
Office Version
  1. 365
Platform
  1. Windows
You are getting the error there because there are no filled cells in the range so xldown is finding cell B1048576 (the last cell in the column) and the + 1 takes it off the sheet.

Try
VBA Code:
Sub Legg_til_Innkjøp()

    Worksheets("Innkjøp").Range("A18").FormulaR1C1 = "=TODAY()"

    Worksheets("Lagerstatus").Unprotect Password:="Norskmodul123"

    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet
    Dim lr As Long

    Set copySheet = Worksheets("Innkjøp")
    Set pasteSheet = Worksheets("Lagerstatus")

    copySheet.Range("A6:AJ6").Copy
    lr = pasteSheet.Range("B" & Rows.Count).End(xlUp).Row
    If lr < 17 Then lr = 17
    pasteSheet.Range("A" & lr + 1).PasteSpecial xlValues

    Application.CutCopyMode = False

    Worksheets("Lagerstatus").Protect Password:="Norskmodul123"

    Range("A6:AJ6").ClearContents

End Sub

Please can you also use code tags when posting code

Thank you so much Mark858 - that did the trick.

Sry regarding posting code - ill keep that in mind for the next time ;)
 

Forum statistics

Threads
1,136,803
Messages
5,677,818
Members
419,722
Latest member
Rizzol

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