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

[Masimo85]

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

 

[MARK858]

What do you want to happen if all the cells in row 18-32 are filled?

 

[Masimo85]

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]

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]

Hi again,

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

And the paste sheet looks like this:

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

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]

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

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

 

[Masimo85]

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

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

 

[MARK858]

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

No problem, you are relatively new to the board so still finding your way around.

Thank you so much Mark858 - that did the trick.

You're welcome