How to copy data row form one sheet to anothe
Closed
Redsh0es
-
Mar 15, 2011 at 10:29 PM
RWomanizer Posts 365 Registration date Monday February 7, 2011 Status Contributor Last seen September 30, 2013 - Mar 16, 2011 at 07:23 AM
RWomanizer Posts 365 Registration date Monday February 7, 2011 Status Contributor Last seen September 30, 2013 - Mar 16, 2011 at 07:23 AM
Related:
- How to copy data row form one sheet to anothe
- Google sheet right to left - Guide
- Wpan full form - Guide
- Transfer data from one excel worksheet to another automatically - Guide
- Windows network commands cheat sheet - Guide
- Saints row 2 cheats - Guide
1 response
RWomanizer
Posts
365
Registration date
Monday February 7, 2011
Status
Contributor
Last seen
September 30, 2013
120
Mar 16, 2011 at 07:23 AM
Mar 16, 2011 at 07:23 AM
Open your workbook,
Press Alt + F11; the visual basic editor will be open paste below code there here;
save it:
To Run the code press Alt + F11 and press the play button on toolbar,
Press Alt + F11; the visual basic editor will be open paste below code there here;
save it:
To Run the code press Alt + F11 and press the play button on toolbar,
Sub DistributeRowsToNewWBS()
Dim wbNew As Worksheet
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim LastRow As Long
Set wsData = Worksheets("Defectives") ' name of worksheet with the data
Set wsCrit = Worksheets.Add
LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
' column H has the criteria
wsData.Range("C1:C" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
Set rngCrit = wsCrit.Range("A2")
While rngCrit.Value <> ""
Set wsNew = Worksheets.Add
' change E to reflect columns to copy
wsData.Range("A1:E" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A1"), Unique:=True
wsNew.Name = rngCrit
Application.DisplayAlerts = False
rngCrit.EntireRow.Delete
Set rngCrit = wsCrit.Range("A2")
Wend
wsCrit.Delete
Application.DisplayAlerts = True
End Sub
