Copy data on another another sheet on the basis of city.

[avisoft20]

Hi,
I have a database on sheet 1 and i want to copy data on the basis of city on separate sheet.

Sheet 1

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]CITY[/TD]
[TD]NAME[/TD]
[TD]ID[/TD]
[/TR]
[TR]
[TD]NEW DELHI[/TD]
[TD]RAKESH[/TD]
[TD]C101[/TD]
[/TR]
[TR]
[TD]PATNA[/TD]
[TD]SUMIT[/TD]
[TD]D102[/TD]
[/TR]
[TR]
[TD]NEW DELHI[/TD]
[TD]RAJU[/TD]
[TD]F103[/TD]
[/TR]
[TR]
[TD]BANGLORE[/TD]
[TD]A.ANNA[/TD]
[TD]R104[/TD]
[/TR]
[TR]
[TD]PATNA[/TD]
[TD]SUMAN[/TD]
[TD]E105[/TD]
[/TR]
[TR]
[TD]BANGLORE[/TD]
[TD]D.RAMAN[/TD]
[TD]R106[/TD]
[/TR]
</tbody>[/TABLE]












I want to extract data on separate separate sheet on the basis of city .

Ans:
Sheet 2

[TABLE="class: grid, width: 300, align: left"]
<tbody>[TR]
[TD]CITY[/TD]
[TD]NAME[/TD]
[TD]ID[/TD]
[/TR]
[TR]
[TD]NEW DELHI[/TD]
[TD]RAKESH[/TD]
[TD]C101[/TD]
[/TR]
[TR]
[TD]NEW DELHI[/TD]
[TD]RAJU[/TD]
[TD]F103[/TD]
[/TR]
</tbody>[/TABLE]






Sheet 3

[TABLE="class: grid, width: 300, align: left"]
<tbody>[TR]
[TD]CITY[/TD]
[TD]NAME[/TD]
[TD]ID[/TD]
[/TR]
[TR]
[TD]PATNA[/TD]
[TD]SUMIT[/TD]
[TD]D102[/TD]
[/TR]
[TR]
[TD]PATNA[/TD]
[TD]SUMAN[/TD]
[TD]E105[/TD]
[/TR]
</tbody>[/TABLE]






Sheet 4

[TABLE="class: grid, width: 300, align: left"]
<tbody>[TR]
[TD]CITY[/TD]
[TD]NAME[/TD]
[TD]ID[/TD]
[/TR]
[TR]
[TD]BANGLORE[/TD]
[TD]A.ANNA[/TD]
[TD]R104[/TD]
[/TR]
[TR]
[TD]BANGLORE[/TD]
[TD]D.RAMAN[/TD]
[TD]R106
[/TD]
[/TR]
</tbody>[/TABLE]






Thanks & Regard
avisoft20

 

[ttray33y]

Hi,
I have a database on sheet 1 and i want to copy data on the basis of city on separate sheet.

Sheet 1

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]CITY[/TD]
[TD]NAME[/TD]
[TD]ID[/TD]
[/TR]
[TR]
[TD]NEW DELHI[/TD]
[TD]RAKESH[/TD]
[TD]C101[/TD]
[/TR]
[TR]
[TD]PATNA[/TD]
[TD]SUMIT[/TD]
[TD]D102[/TD]
[/TR]
[TR]
[TD]NEW DELHI[/TD]
[TD]RAJU[/TD]
[TD]F103[/TD]
[/TR]
[TR]
[TD]BANGLORE[/TD]
[TD]A.ANNA[/TD]
[TD]R104[/TD]
[/TR]
[TR]
[TD]PATNA[/TD]
[TD]SUMAN[/TD]
[TD]E105[/TD]
[/TR]
[TR]
[TD]BANGLORE[/TD]
[TD]D.RAMAN[/TD]
[TD]R106[/TD]
[/TR]
</tbody>[/TABLE]












I want to extract data on separate separate sheet on the basis of city .

Ans:
Sheet 2

[TABLE="class: grid, width: 300, align: left"]
<tbody>[TR]
[TD]CITY[/TD]
[TD]NAME[/TD]
[TD]ID[/TD]
[/TR]
[TR]
[TD]NEW DELHI[/TD]
[TD]RAKESH[/TD]
[TD]C101[/TD]
[/TR]
[TR]
[TD]NEW DELHI[/TD]
[TD]RAJU[/TD]
[TD]F103[/TD]
[/TR]
</tbody>[/TABLE]






Sheet 3

[TABLE="class: grid, width: 300, align: left"]
<tbody>[TR]
[TD]CITY[/TD]
[TD]NAME[/TD]
[TD]ID[/TD]
[/TR]
[TR]
[TD]PATNA[/TD]
[TD]SUMIT[/TD]
[TD]D102[/TD]
[/TR]
[TR]
[TD]PATNA[/TD]
[TD]SUMAN[/TD]
[TD]E105[/TD]
[/TR]
</tbody>[/TABLE]






Sheet 4

[TABLE="class: grid, width: 300, align: left"]
<tbody>[TR]
[TD]CITY[/TD]
[TD]NAME[/TD]
[TD]ID[/TD]
[/TR]
[TR]
[TD]BANGLORE[/TD]
[TD]A.ANNA[/TD]
[TD]R104[/TD]
[/TR]
[TR]
[TD]BANGLORE[/TD]
[TD]D.RAMAN[/TD]
[TD]R106[/TD]
[/TR]
</tbody>[/TABLE]






Thanks & Regard
avisoft20

easier approach no coding involve, convert your data to table, then create Pivot table each sheet with corresponding city.

 

[ttray33y]

Hi,
I have a database on sheet 1 and i want to copy data on the basis of city on separate sheet.
avisoft20

try:

Option Explicit
    
Sub drv()
    Dim v As Variant
    Dim v1 As Variant
    Dim newsheet
    Dim Lrow As Long
    Dim i As Long
    
    Lrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    v = sList(Worksheets("Sheet1").Range("A2:A" & Lrow))
Application.ScreenUpdating = False
    For Each v1 In v
        With ThisWorkbook
            Set newsheet = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            newsheet.Name = v1
                With ActiveWorkbook.Sheets(v1)
                .Cells(1, 1).Value = "CITY"
                .Cells(1, 2).Value = "NAME"
                .Cells(1, 3).Value = "ID"
                End With
        End With
    For i = 2 To Lrow
        With ActiveWorkbook.Sheets("Sheet1")
            If .Cells(i, 1) = v1 Then
                .Range(.Cells(i, 1), .Cells(i, 3)).Copy Destination:=ActiveWorkbook.Sheets(v1).Range("A2000").End(xlUp).Offset(1, 0)
            End If
        End With
    Next i
    Next
Application.ScreenUpdating = True
End Sub




Public Function sList(R As Range) As Variant
    Dim A() As String
    Dim C As Collection
    Dim R1 As Range
    Dim i As Long
    
    Set C = New Collection
    
    On Error Resume Next
    For Each R1 In R.Cells
        C.Add R1.Value, CStr(R1.Value)
    Next
    On Error GoTo 0
    
    ReDim A(1 To C.Count)
    
    For i = 1 To C.Count
        A(i) = C.Item(i)
    Next i
    
    sList = A
End Function

paste this code in a module.

 

[avisoft20]

Thanks you so much . Mr.ttray33y





Sub drv()
Dim v As Variant
Dim v1 As Variant
Dim newsheet
Dim Lrow As Long
Dim i As Long

Lrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

v = sList(Worksheets("Sheet1").Range("A2:A" & Lrow))
Application.ScreenUpdating = False
For Each v1 In v
With ThisWorkbook
Set newsheet = .Sheets.Add(After:=.Sheets(.Sheets.Count))
newsheet.Name = v1
With ActiveWorkbook.Sheets(v1)
.Cells(1, 1).Value = "CITY"
.Cells(1, 2).Value = "NAME"
.Cells(1, 3).Value = "ID"
End With
End With
For i = 2 To Lrow
With ActiveWorkbook.Sheets("Sheet1")
If .Cells(i, 1) = v1 Then
.Range(.Cells(i, 1), .Cells(i, 3)).Copy Destination:=ActiveWorkbook.Sheets(v1).Range("A2000").End(xlUp).Offset(1, 0)
End If
End With
Next i
Next
Application.ScreenUpdating = True
End Sub




Public Function sList(R As Range) As Variant
Dim A() As String
Dim C As Collection
Dim R1 As Range
Dim i As Long

Set C = New Collection

On Error Resume Next
For Each R1 In R.Cells
C.Add R1.Value, CStr(R1.Value)
Next
On Error GoTo 0

ReDim A(1 To C.Count)

For i = 1 To C.Count
A(i) = C.Item(i)
Next i

sList = A
End Function

[/CODE]

paste this code in a module.[/QUOTE]