0
Thanks

A few words of thanks would be greatly appreciated.

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



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.
0
Thanks

A few words of thanks would be greatly appreciated.

Ask a question
Jean-François Pillou

CCM is a leading international tech website. Our content is written in collaboration with IT experts, under the direction of Jeff Pillou, founder of CCM.net. CCM reaches more than 50 million unique visitors per month and is available in 11 languages.

Learn more about the CCM team

Published by . Latest update on 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 (https://ccm.net/).

0 Comments