A VBA code to conditionally copy data from one sheet to another

March 2017



Issue


I need a VBA code that can copy data from sheet1(raw data) to sheet 2,sheet3 and so on...based on a certain condition matches.
column---A------------B------------C------------D-------E
-----------name-----place----company---country
-----------name1----AB-------Nokia-------USA
-----------name2----CD-------Sony--------UK
-----------name3-----EF-------LG-----------INDIA
-----------name4-----AB------Sony------RUSSIA
-----------name5-----AB------Sony------GERMANY
-----------name6-----CD------Nokia------INDIA
-----------name7-----CD------Ericsson--USA
-----------name8-----EF------Ericsson----RUSSIA
-----------name9-----GH------Lenore-----UK
-----------name10---GH-------HP---------INDIA

Solution


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


Thanks to RWomanizerfor this tip.

Related


Published by aakai1056.
This document, titled "A VBA code to conditionally copy data from one sheet to another," is available under the Creative Commons license. Any copy, reuse, or modification of the content should be sufficiently credited to CCM (ccm.net).