Help, Copy next cell and paste it

[Holdynski]

Hi there!

I have a problem with copy and pasting values into another sheet with a button(Macro). I will explain what i mean.

For example, i have 2 columns, A and B in sheet1.

Column A is ID number. (Every ID is unique)
Column B is Orders. (Between 1-50)

Lets say that i have 10 rows with data in both Column A and B.
Row A) B)
1 567 2
2 123 33
3 432 4
4 653 2
5 111 18
6 145 33
7 999 2
8 685 1
9 434 18
10 222 2

After that i filter in column B, and sorting for orders of 2. Witch will look like this after:

Row A) B)
1 567 2
4 653 2
7 999 2
10 222 2

After sorting, i want to copy the first ID number (column A) in to A1 in sheet2 with a button (Macro).
After copying the first ID number, i want the second witch is on row 4. And i want to click the same button witch can find the next ID on orders of 2 and paste it, also on A1 in sheet2.
And so on. So everytime i press the button it goes like this:

"Copy (A1), paste in A1 sheet2"
"Copy next (A4), paste in A1 sheet2"
"Copy next (A7), paste in A1 sheet2"
"Copy next (A10), paste in A1 sheet2"

Can someone help me with that ? Sorry for my English....

 

[arviy2k]

If I understood correctly, you are looking to overwrite the pasted value?

Taking your example, it will first take 567 (A1) and paste in Sheet 2, cell A1
next, it will take 653 (A4) and paste again in Sheet 2, cell A1 (overwriting 567 which was already present there)

Is this what you are looking for?

Regards,
ArvindYoga

 

[Holdynski]

Yes exactly. So long, I've found a "kinda" working script but will not work if you filter. It only goes to next cell (no mater if you filtered). It look like this:

Sub CopyPaste()
'
' CopyPaste Macro
'


'
Sheets("Sheet1").Select
Dim x As Long, y As Long
x = ActiveCell.Row
y = ActiveCell.Column
x = x + 1
Cells(x, y).Select
Selection.Copy
Sheets("Sheet2").Select
Range("I32").Select
ActiveSheet.Paste
End Sub

 

[Fishboy]

Yes exactly. So long, I've found a "kinda" working script but will not work if you filter. It only goes to next cell (no mater if you filtered). It look like this:

Sub CopyPaste()
'
' CopyPaste Macro
'


'
Sheets("Sheet1").Select
Dim x As Long, y As Long
x = ActiveCell.Row
y = ActiveCell.Column
x = x + 1
Cells(x, y).Select
Selection.Copy
Sheets("Sheet2").Select
Range("I32").Select
ActiveSheet.Paste
End Sub

Hi Holdynski, welcome to the boards.

So long as you have headers in row 1 of both sheets then the following macro should do what you need without the need for a loop:

Sub CopyData()
' Defines variables
Dim LastRow As Long, LastRow2 As Long


' Defines LastRow as the last row of data on Sheet1 based on column A
LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
' Defines LastRow2 as the first blank row of data on Sheet2 based on column A
LastRow2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1


' Copy all visible cells from Sheet1 column A to the first blank row of Sheet2 column A
Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Sheet2").Range("A" & LastRow2)


' Turn off cut / copy mode (the dotted lines)
Application.CutCopyMode = False


End Sub

[EDIT] - You can see this working by downloading my test workbook HERE

 

[Holdynski]

Hi Holdynski, welcome to the boards.

So long as you have headers in row 1 of both sheets then the following macro should do what you need without the need for a loop:

Sub CopyData()
' Defines variables
Dim LastRow As Long, LastRow2 As Long


' Defines LastRow as the last row of data on Sheet1 based on column A
LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
' Defines LastRow2 as the first blank row of data on Sheet2 based on column A
LastRow2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1


' Copy all visible cells from Sheet1 column A to the first blank row of Sheet2 column A
Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Sheet2").Range("A" & LastRow2)


' Turn off cut / copy mode (the dotted lines)
Application.CutCopyMode = False


End Sub

[EDIT] - You can see this working by downloading my test workbook HERE

Hi,

That doesnt work for me.. Maybe i'm doing something wrong but it wont work. But i tried by myself and i wrote one who works perfect now. But hey, thank you so much anyway, very appreciated!

This is the code i'm using:

Sub CopyPasteFilter()
'
' CopyPasteFilter Macro
'


'


Sheets("Sheet1").Select
Dim x As Long, y As Long
x = ActiveCell.Row
y = ActiveCell.Column
x = x + 1
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop
Selection.Copy
Sheets("Sheet2").Select
Range("A4").Select
ActiveSheet.Paste

End Sub

 

[Fishboy]

Hi,

That doesnt work for me.. Maybe i'm doing something wrong but it wont work. But i tried by myself and i wrote one who works perfect now. But hey, thank you so much anyway, very appreciated!

This is the code i'm using:

Sub CopyPasteFilter()
'
' CopyPasteFilter Macro
'


'


Sheets("Sheet1").Select
Dim x As Long, y As Long
x = ActiveCell.Row
y = ActiveCell.Column
x = x + 1
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop
Selection.Copy
Sheets("Sheet2").Select
Range("A4").Select
ActiveSheet.Paste

End Sub

Very strange as the example workbook I uploaded is working fine exactly as described without issue. I don't see how you could do something wrong using the example workbook to make it not work.

Either way I am glad you have found a solution that works for you. It is worth noting however that from a resource use / process time perspective, using a loop can be highly inefficient and time consuming on larger data sets.