Previous Topic Next Topic

Macro in Excel to copy and paste selected from one Sheet

Closed
chiragz
Posts
1
Registration date
Saturday May 31, 2014
Status
Member
Last seen
May 31, 2014
 - May 31, 2014 at 03:59 AM
venkat1926
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
 - Jun 2, 2014 at 03:55 AM
Hi

I have an excel with couple of sheets. 1st sheet contains summarized data. Now I want to scatter the summarized data and copy the same data in the 2nd sheet. Data in 2nd sheet should be separated name wise, item wise and buy/sell wise. So, please tell me a macro which can be run to copy the summarized data and separate the data in the 2nd sheet. I am hereby copying the data from sheet 1 and also the copying the dat of sheet 2 (What i Want in sheet 2). I need Macro to do some automation as well so that everytime I run Macro the data should be separated/copied/paste automatically in the Sheet 2. Please see below the data itself.

Sheet 1
Name Item B/S Rate Quantity
Birav Silver Buy 40125 30
Birav Gold Sell 27150 1000
Chirag Silver Buy 40120 30
Chirag Silver Sell 39900 30
Chirag Gold Buy 39752 1000
Chirag Silver Sell 40084 30
Pintu Gold Buy 27100 1000
Pulin Gold Buy 26850 1000
Pulin Silver Sell 40100 30
Raj Gold Buy 26800 1000
Raj Silver Sell 39850 30
Raj Silver Buy 40096 30

Sheet 2 (This is what I wanted after i Run a Macro)

Chirag
Item B/S Rate Quantity
Silver Buy 40120 30
Silver Sell 39900 30
Silver Sell 40084 30
Gold Buy 39752 1000

Please send me the Macro ASAP.

1 reply

Answer 1 / 1
venkat1926
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
 810
Jun 2, 2014 at 03:55 AM
download file using this file address

http://speedy.sh/V4uuW/chirag-140602-macro-enabled.xlsm

ENABLE MACROS
REMOVE THAT MSGBOX LINE OR JUST INTRODUCE A APOSTROPHE (') AT THE BEGIBIG OF THIS CODE LINE

run the macro "TEST" in vb editor (which is also repeated here)
and see sheet3 

Sub test()
Dim rdata As Range, nnames As Range, unqname As Range, cunqname As Range, x As String
Dim dest As Range
Worksheets("sheet3").Cells.Clear
Worksheets("sheet1").Activate
Range(Range("A1").End(xlDown).Offset(1, 0), Cells(Rows.Count, "A")).EntireRow.Delete

Set rdata = Range("A1").CurrentRegion
Set nnames = Range(Range("A1"), Range("A1").End(xlDown))
Set unqname = Range("a1").End(xlDown).Offset(5, 0)

nnames.AdvancedFilter xlFilterCopy, , unqname, True
Set unqname = Range(unqname.Offset(1, 0), Cells(Rows.Count, "A").End(xlUp))
For Each cunqname In unqname
x = cunqname
MsgBox x
rdata.AutoFilter field:=1, Criteria1:=x
rdata.SpecialCells(xlCellTypeVisible).Copy
With Worksheets("sheet3")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(2, 0)
dest = x
dest.Offset(1, 0).PasteSpecial
End With
ActiveSheet.AutoFilterMode = False
Next cunqname
Range(Range("A1").End(xlDown).Offset(1, 0), Cells(Rows.Count, "A")).EntireRow.Delete
End Sub
0