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

avisoft20

avisoft20

Board Regular
Joined
Sep 10, 2016
Messages
64
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
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
avisoft20 said:
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
Click to expand...
easier approach no coding involve, convert your data to table, then create Pivot table each sheet with corresponding city.
 
Upvote 0
avisoft20 said:
Hi,
I have a database on sheet 1 and i want to copy data on the basis of city on separate sheet.
avisoft20
Click to expand...

try:
Code: 
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.
 
Upvote 0
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]
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
Copy Data from Row into certain Cells on another sheet than. LOOP through each row
Replies
1
Views
653
Rosen
R
D
  • Question Question
Checking user input and copying/pasting it to another worksheet
Replies
1
Views
569
Darmlucht
D
M
  • Question Question
Pull Specific Data from one Sheet to Another using Macro
2
Replies
13
Views
1K
Fluff
Fluff
K
  • Question Question
Copy excel entries into new work sheet and rearrange the values
2
Replies
16
Views
1K
KokoroAyo
K
B
  • Question Question
Need help using VBA to copy data from one sheet into another sheet based on specific date
2
Replies
11
Views
2K
My Aswer Is This
My Aswer Is This

Forum statistics

Threads
1,223,911
Messages
6,175,323
Members
452,635
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top