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 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Jun 2, 2014 at 03:55 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Jun 2, 2014 at 03:55 AM
Related:
- Macro in Excel to copy and paste selected from one Sheet
- Mark sheet in excel - Guide
- How to open excel sheet in notepad++ - Guide
- How to take screenshot of selected area in excel - Guide
- Sheet right to left in google sheet - Guide
- Number to words in excel - Guide
1 response
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Jun 2, 2014 at 03:55 AM
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
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