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

December 2016



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 :

This document entitled « A VBA code to conditionally copy data from one sheet to another » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.