VBA code to conditionally copy the data
Solved/Closed
sunny2u86
sunny2u86
- Posts
- 14
- Registration date
- Thursday February 2, 2012
- Status
- Member
- Last seen
- June 4, 2012
sunny2u86
- Posts
- 14
- Registration date
- Thursday February 2, 2012
- Status
- Member
- Last seen
- June 4, 2012
Related:
- VBA code to conditionally copy the data
- Vba code to search data in excel - Guide
- Vba code to copy data from one sheet to another based on criteria ✓ - Forum - Excel
- Vba code to copy data from one workbook to another - Guide
- Vba code to transfer data from one sheet to another - Guide
- Vba code to update data in excel - Guide
9 replies
RWomanizer
May 24, 2012 at 04:26 AM
- Posts
- 365
- Registration date
- Monday February 7, 2011
- Status
- Contributor
- Last seen
- September 30, 2013
May 24, 2012 at 04:26 AM
You can use following codes
Sub SplitSheets()
Dim DataSht, wsCrit, SplitSht As Worksheet
Dim lrUnq, lrData, I As Long
Dim FtrVal As String
Application.ScreenUpdating = False
Set DataSht = Worksheets("sheet1") 'change it to the name of your raw data sheet
lrData = DataSht.Range("a" & Rows.Count).End(xlUp).Row
Set wsCrit = Worksheets.Add
DataSht.Range("B1:l" & lrData).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=wsCrit.Range("A1"), Unique:=True
lrUnq = wsCrit.Range("a" & Rows.Count).End(xlUp).Row
For I = 2 To lrUnq
FtrVal = wsCrit.Range("A" & i).Value
Set SplitSht = Worksheets.Add
DataSht.Select
'DataSht.ShowAllData
ActiveSheet.AutoFilterMode = False
ActiveSheet.Range("A1:Z" & lrData).AutoFilter Field:=2, Criteria1:=FtrVal
Range("a1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
SplitSht.Select
Range("A1").Select
ActiveSheet.Paste
'Cells.Select
Cells.EntireColumn.AutoFit
SplitSht.Name = FtrVal
Application.CutCopyMode = False
Next i
Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True
.AutoFilterMode = False
End Sub
Sub SplitSheets()
Dim DataSht, wsCrit, SplitSht As Worksheet
Dim lrUnq, lrData, I As Long
Dim FtrVal As String
Application.ScreenUpdating = False
Set DataSht = Worksheets("sheet1") 'change it to the name of your raw data sheet
lrData = DataSht.Range("a" & Rows.Count).End(xlUp).Row
Set wsCrit = Worksheets.Add
DataSht.Range("B1:l" & lrData).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=wsCrit.Range("A1"), Unique:=True
lrUnq = wsCrit.Range("a" & Rows.Count).End(xlUp).Row
For I = 2 To lrUnq
FtrVal = wsCrit.Range("A" & i).Value
Set SplitSht = Worksheets.Add
DataSht.Select
'DataSht.ShowAllData
ActiveSheet.AutoFilterMode = False
ActiveSheet.Range("A1:Z" & lrData).AutoFilter Field:=2, Criteria1:=FtrVal
Range("a1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
SplitSht.Select
Range("A1").Select
ActiveSheet.Paste
'Cells.Select
Cells.EntireColumn.AutoFit
SplitSht.Name = FtrVal
Application.CutCopyMode = False
Next i
Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True
.AutoFilterMode = False
End Sub
sunny2u86
May 27, 2012 at 02:20 AM
- Posts
- 14
- Registration date
- Thursday February 2, 2012
- Status
- Member
- Last seen
- June 4, 2012
May 27, 2012 at 02:20 AM
is any one who can help me..pls.
sunny2u86
May 28, 2012 at 11:30 AM
- Posts
- 14
- Registration date
- Thursday February 2, 2012
- Status
- Member
- Last seen
- June 4, 2012
May 28, 2012 at 11:30 AM
hi please use the this link to get the raw file " http://speedy.sh/RJs2g/pending-raw.xls "
he data it contain is different then I asked but the logic is same.I need all the data in sheet1 will be copied to the sheet2,sheet3 and so on according to the "Group" in sheet1..
the sheet attached is without macro.
thank you
sunny.
he data it contain is different then I asked but the logic is same.I need all the data in sheet1 will be copied to the sheet2,sheet3 and so on according to the "Group" in sheet1..
the sheet attached is without macro.
thank you
sunny.
TrowaD
May 29, 2012 at 10:50 AM
- Posts
- 2880
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- May 2, 2022
May 29, 2012 at 10:50 AM
Hi Sunny,
Is it possible to name each sheet after the group they are in?
So don't name your sheet: "FO CAL" but "Field Ops - Calgary".
Or keep the sheet name "FO CAL" and change the groupname accordingly.
Make a sheet for every groupname.
Post your results.
Best regards,
Trowa
Is it possible to name each sheet after the group they are in?
So don't name your sheet: "FO CAL" but "Field Ops - Calgary".
Or keep the sheet name "FO CAL" and change the groupname accordingly.
Make a sheet for every groupname.
Post your results.
Best regards,
Trowa
sunny2u86
May 30, 2012 at 10:22 AM
- Posts
- 14
- Registration date
- Thursday February 2, 2012
- Status
- Member
- Last seen
- June 4, 2012
May 30, 2012 at 10:22 AM
Hi Trowa,
yes you can change the name of the sheet according to the group they are in say
"Field Ops - Calgary"..
Please let me know if you need any other details.
Thank You,
Sunny
yes you can change the name of the sheet according to the group they are in say
"Field Ops - Calgary"..
Please let me know if you need any other details.
Thank You,
Sunny
Didn't find the answer you are looking for?
Ask a question
sunny2u86
May 30, 2012 at 10:21 AM
- Posts
- 14
- Registration date
- Thursday February 2, 2012
- Status
- Member
- Last seen
- June 4, 2012
May 30, 2012 at 10:21 AM
HI Trowa,
yes you can change the name of the sheet according to the group they are in say
"Field Ops - Calgary"..
Please let me know if you need any other details.
Thank You,
Sunny
yes you can change the name of the sheet according to the group they are in say
"Field Ops - Calgary"..
Please let me know if you need any other details.
Thank You,
Sunny
TrowaD
May 31, 2012 at 09:23 AM
- Posts
- 2880
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- May 2, 2022
May 31, 2012 at 09:23 AM
Good one Sunny,
I meant for you to change the sheet names.
But since I had some spare time (and I am a kind person) I did it for you.
Here is the code:
And here is your file with code:
http://speedy.sh/acm4R/Sunny-pending-raw.xls
Best regards,
Trowa
I meant for you to change the sheet names.
But since I had some spare time (and I am a kind person) I did it for you.
Here is the code:
Sub MoveData() Dim lRow As Integer lRow = Range("A" & Rows.Count).End(xlUp).Row Sheets("raw").Activate For Each cell In Range("F2:F" & lRow) cell.EntireRow.Copy Sheets(cell.Value).Activate Range("B" & Rows.Count).End(xlUp).Offset(1, -1).PasteSpecial Next cell Application.CutCopyMode = False End Sub
And here is your file with code:
http://speedy.sh/acm4R/Sunny-pending-raw.xls
Best regards,
Trowa
sunny2u86
May 31, 2012 at 10:38 AM
- Posts
- 14
- Registration date
- Thursday February 2, 2012
- Status
- Member
- Last seen
- June 4, 2012
May 31, 2012 at 10:38 AM
Hi Trowa,
Great work again from you man!
I really appreciate your work,but one question,since this raw data is changeable and new group is added as required so can you tell me how can it change it according to the requirement..
thank you
Sunny
Great work again from you man!
I really appreciate your work,but one question,since this raw data is changeable and new group is added as required so can you tell me how can it change it according to the requirement..
thank you
Sunny
TrowaD
Jun 4, 2012 at 10:19 AM
- Posts
- 2880
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- May 2, 2022
Jun 4, 2012 at 10:19 AM
Hi Sunny,
Good to see you like it :).
The adjusted code will check if a sheet already exists with the groups name. If not, a sheets is created with the missing groups name along with the format (first row header and column width of the first 6 columns.).
Here is the code:
And here is your file with code for your convenience:
http://speedy.sh/zvnTp/Sunny-pending-raw.xls
Kind regards,
Trowa
Good to see you like it :).
The adjusted code will check if a sheet already exists with the groups name. If not, a sheets is created with the missing groups name along with the format (first row header and column width of the first 6 columns.).
Here is the code:
Sub MoveData() Dim lRow As Integer lRow = Range("A" & Rows.Count).End(xlUp).Row Sheets("raw").Activate For Each cell In Range("F2:F" & lRow) If Not SheetExists(cell.Value) Then Sheets.Add ActiveSheet.Name = cell.Value Sheets("raw").Range("A1:F1").Copy Sheets(cell.Value).Range("A1").PasteSpecial Paste:=xlPasteAll Sheets(cell.Value).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths End If cell.EntireRow.Copy Sheets(cell.Value).Activate Range("B" & Rows.Count).End(xlUp).Offset(1, -1).PasteSpecial Next cell Application.CutCopyMode = False End Sub Function SheetExists(SheetName As String) As Boolean SheetExists = False On Error GoTo NoSuchSheet If Len(Sheets(SheetName).Name) > 0 Then SheetExists = True Exit Function End If NoSuchSheet: End Function
And here is your file with code for your convenience:
http://speedy.sh/zvnTp/Sunny-pending-raw.xls
Kind regards,
Trowa
sunny2u86
Jun 4, 2012 at 11:34 AM
- Posts
- 14
- Registration date
- Thursday February 2, 2012
- Status
- Member
- Last seen
- June 4, 2012
Jun 4, 2012 at 11:34 AM
Hey man,
Thanks again for your help!
thank you,
Sunny..
Thanks again for your help!
thank you,
Sunny..
May 24, 2012 at 02:00 PM
but this is showing error called "invalid and unqualified" and also please let me know where we can set the condition?