Solved: To Copy Cell in other sheets

[boilingrony]

Can any one help me out on copying the data to other sheet..


I mean to say that there is duplicate data in a cell & is repeated Continuously in n number of time Can it Be copied on by excel vba macro code in other sheet

[GTO]

Greetings biolingrony,

I think that you will need to be a bit more descriptive for us to know what you are trying to accomplish. If it is hard to describe, maybe attach an example workbook, showing the data we want to copy, why this data gets picked to copy, and where it goes.

I hope that makes sense,

Mark

[boilingrony]

Well You can find the attachment here.

I required the data {BRANCH NAME} gets copied in other sheets.

Eg. i put branch name= NEW FRIENDS COLONY; it search's for NEW FRIENDS COLONY Creates a sheet & copies all information related to NEW FRIENDS COLONY into the sheet.

[boilingrony]

Still waiting for Reply..

[GTO]

Hi there,

Sorry, I forgot about this. Still not exactly sure, but think this should be close.

In a userform, add a combobox and two commandbuttons, named as shown in code.

In the Userform's Module:


Option Explicit

Dim rngData As Range

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdOK_Click()
Dim _
wksNew As Worksheet, _
i As Long, _
strShName As String, _
bolNamed As Boolean

Me.Hide

Set wksNew = Worksheets.Add(, ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))

strShName = cboBranchName.Value
If Not ShExists(strShName, , True) Then
wksNew.Name = strShName
Else
Do
i = i + 1
strShName = cboBranchName.Value & "_" & i

If Not ShExists(strShName, , True) Then
wksNew.Name = strShName
bolNamed = True
End If
Loop While Not bolNamed

End If

With rngData.Offset(-1).Resize(rngData.Rows.Count + 1)
.AutoFilter Field:=1, Criteria1:=cboBranchName.Value
.SpecialCells(xlCellTypeVisible).EntireRow.Copy wksNew.Range("A1")
wksNew.UsedRange.EntireColumn.AutoFit
.Parent.AutoFilterMode = False
End With

Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim _
wksData As Worksheet, _
rngLRow As Range

Set wksData = ThisWorkbook.Worksheets("CMH")

With wksData
Set rngLRow = RangeFound(.Range("B2:B" & Rows.Count))
If rngLRow Is Nothing Then
MsgBox "Nothing Found", 0, vbNullString
Exit Sub
End If
Set rngData = Range(.Range("B2"), rngLRow)
End With

Me.cboBranchName.List = GetCol(rngData.Value)
Me.cboBranchName.ListIndex = 0
End Sub


In a Standard Module:


Option Explicit

Function GetCol(aData As Variant) As Variant()
Dim _
i As Long, _
ii As Long, _
COL As Collection

Set COL = New Collection
With COL

On Error Resume Next
.Add "dummy", "dummy"
For i = LBound(aData, 1) To UBound(aData, 1)
If Not aData(i, 1) = vbNullString Then
For ii = 1 To .Count
If LCase(aData(i, 1)) < LCase(COL(ii)) Then
.Add aData(i, 1), CStr(aData(i, 1)), ii
Exit For
End If
Next
.Add aData(i, 1), CStr(aData(i, 1))
End If
Next
On Error GoTo 0
.Remove "dummy"

ReDim aData(0 To .Count - 1)

For i = 0 To .Count - 1
aData(i) = .Item(i + 1)
Next
End With

GetCol = aData

Erase aData
Set COL = Nothing
End Function

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=False)
End Function

Function ShExists(ShName As String, _
Optional WB As Workbook, _
Optional IgnoreCase As Boolean = False) As Boolean

If WB Is Nothing Then
Set WB = ThisWorkbook
End If

If IgnoreCase Then
On Error Resume Next
ShExists = CBool(UCase(WB.Worksheets(ShName).Name) = UCase(ShName))
On Error GoTo 0
Else
On Error Resume Next
ShExists = CBool(WB.Worksheets(ShName).Name = ShName)
On Error GoTo 0
End If
End Function

See attached example. If that does the trick, or is close, and you would like the code explained a bit, post back, and when I get a chance, I'll repost the code, commented up a bit.

Hope that helps,

Mark

[boilingrony]

Thankyou It worked..:thumb:thumb:friends::friends::clap::clap:

[lucas]

Be sure to mark your thread solved using the thread tools at the top of the page.