Copy Cells without losing data

[LEKKERDING]

Hi,

I have a problem. I want to copy cells from sheet1 to sheet2.
The following cells I want to be copied:

Sheet1 Cell "B17" to sheet2 Cell "A4"
Sheet1 Cell "R14" to sheet2 Cell "C4"
Sheet1 Cell "H12" to sheet2 Cell "E4"
Sheet1 Cell "H12" to sheet2 Cell "G4"

Now here comes the problem. I want to be able to do this once every week. And the cells, A4, C4, E4, G4 I don't want to lose those cells so I want those to be copied two rows lower, so that there will be one empty row. So they'll be copied to the cells, A6, C6, E6, G6. And then the next week that goes on again. From sheet1 to sheet2, from sheet2 Cells, A4, C4, E4, G4 to the cells, A6, C6, E6, G6 and the cells A6, C6, E6, G6 to A8, C8, E8, G8. And the week after that it goes on and on, so that I never lose any values. And it can go up to Rows somewhere in the hundred So I hope someone can help me out. I hope someone knows an easy way so it won't take all that long. Thanks.

 

[Tom Urtis]

Well, you said you wanted an easy way, so how about this. If I understand you correctly, you want to keep a running record of data from week to week, but basically keep the most recent values in row 4 of Sheet2. So, that essentially means if we insert 2 rows before moving everything over from Sheet1, then that would achieve the effect you are after.

The following code does that.

Notice this code is efficient because at no time does it select or activate any cells or sheets, which means it is quick, and easy on your system's memory.

Sub KeepKoppy()
Sheets("Sheet2").Range("A4").EntireRow.Resize(2).Insert
Sheets("Sheet2").Range("A4").Value = Sheets("Sheet1").Range("B17").Value
Sheets("Sheet2").Range("C4").Value = Sheets("Sheet1").Range("R14").Value
Sheets("Sheet2").Range("E4,G4").Value = Sheets("Sheet1").Range("H12").Value
End Sub

 

[LEKKERDING]

THANKS MAN!

This is exactly what I needed. Thanks again.