PDA

View Full Version : Copy paste all data with duplicates to new sheet



guatelize
09-17-2008, 02:52 AM
Hello

I found a macro which copies all data form one sheet to another.
How can I modify it to copy all of the data, even with duplicates ?
(http://support.microsoft.com/kb/213292/en-us)

Thanks for your help




Sub Button1_Click()
' Selects sheet1.
Worksheets("sheet1").Select
' Selects cell A2.
Range("a2").Select
' Turns off screen updating, which helps macro run faster.
Application.ScreenUpdating = False
' Will run the below code until the active cell is blank.
Do While ActiveCell.Value <> ""
' Flag is used to determine whether the record should be pasted
' to Sheet2.
flag = True
' The variable value1 is assigned the value in the currently
' selected cell, initially cell A2.
valuea = ActiveCell.Value
' Valueb is assigned the value in the cell one column to the
' right of the activecell, initially cell B2.
valueb = ActiveCell.Offset(0, 1).Value
' Beginaddrs is assigned the address of the activecell.
beginaddrs = ActiveCell.Address
' Endaddrs is assigned the address of the last contiguous cell
' of data on the active row.
endaddrs = ActiveCell.End(xlToRight).Address
' Copies the current row's record to Clipboard.
Range(beginaddrs & ":" & endaddrs).Copy
' Selects sheet2.
Sheets("sheet2").Select
' Selects cell A2.
Range("a2").Select
' Determine if the record type has already been copied to
' Sheet2.
Do While ActiveCell.Value <> ""
' If valuea, which contains the value from sheet1, equals
' the active cell's value in sheet2, and valueb equals
' the value in the cell immediately to the right of the
' active cell, then do the lines before the Else.
If valuea = ActiveCell.Value And valueb = _
ActiveCell.Offset(0, 1).Value Then
' Flag used in an If statement below. False indicates do
' not paste record.
flag = False
' Rowcount is assigned the current number of contiguous
' rows of records.
RowCount = Range("a1").CurrentRegion.Rows.Count
' Selects a blank row to exit out of Do While.
Range("a" & RowCount).Offset(1, 0).Select
Else
' Otherwise, select next record on Sheet2.
ActiveCell.Offset(1, 0).Select
End If
' Check next record for a duplicate.
Loop
' If flag was not set to False in the previous Do While Loop,
' for example, record type not in sheet2, then do the lines
' before the End If.
If flag Then
' Rowcount is assigned the current number of contiguous rows
' of records.
RowCount = Range("a1").CurrentRegion.Rows.Count
' Pastes the new record type after the last record.
Range("a" & RowCount).Offset(1, 0).PasteSpecial
End If
' Selects sheet1.
Sheets("sheet1").Select
' Selects the next record on Sheet1.
Range(beginaddrs).Offset(1, 0).Select
' Returns back to first Do While to repeat the above process.
Loop
' Turns ScreenUpdating back on.
Application.ScreenUpdating = True
' Removes the marquee around last copied record.
Application.CutCopyMode = False

End Sub

MaximS
09-17-2008, 03:13 AM
try this code:


Sub Copy_Paste()

Sheets("Sheet1").Select

Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row

Sheets("Sheet2").Select

'Selecting all data from Sheet2
Range("A1").Select
Range(Selection.End(xlToRight), Selection.End(xlDown)).Select

'Copying/passting data from Sheet2 to Sheet1 after last row containing data
Selection.Copy Destination:=Sheets("Sheet1").Range("A" & _
LastRow + 1)
End Sub

guatelize
09-17-2008, 03:22 AM
Thanks very much for your help. It works very well. I'm trying to combine also this code with my thread : http://vbaexpress.com/forum/showthread.php?t=22275
If you can help me ?
Thanks