Thanks..

I have tried this way of course a working solution I have .. I need to
get this run through a userform..



On Aug 1, 6:04*pm, Joel wrote:
try this

Option Explicit
Public StartWS As Worksheet
Public CopyRng As Range

Public Sub CopyToVisibleOnly1()

* *'Start with cell selected that you want to copy.
* *Set StartWS = ActiveSheet
* *Set CopyRng = Selection
* *'Call CopyToVisibleOnly2 after a five-second delay.
* *Application.OnTime Now() + TimeValue("0:00:04"), _
* * * "CopyToVisibleOnly2"
End Sub

Private Sub CopyToVisibleOnly2()
* *'Declare local variables.
* *Dim EndWB As Workbook, EndWS As Worksheet
* *Dim Target As Range, CurrCell As Range
* *Dim x As Long, FromCnt As Long

* *Dim Cell As Range
* *Dim MyRow As Range
* *Dim SourceRow As Long
* *Dim SourceRows As Long
* *Dim SourceCol As Long
* *Dim SourceCols As Long

* *Application.ScreenUpdating = False

* *'Select the range where it should be pasted.
* *Set Target = Application.InputBox _
* * * (Prompt:="Select the first cell in the Paste range", Type:=8)

* *SourceRows = CopyRng.Rows.Count
* *SourceCols = CopyRng.columns.Count
* *SourceRow = 1
* *SourceCol = 1
* *For Each MyRow In Target
* * * For Each Cell In MyRow.Cells
* * * * *If Cell.Visible = True Then
* * * * * * StartWS.Cells(SourceRow, SourceCol).Copy _
* * * * * * * * * Destination:=Cell
* * * * * * 'increment to next cell
* * * * * * If SourceCol = SourceCols Then
* * * * * * * *SourceRow = SourceRow + 1
* * * * * * * *SourceCol = 1
* * * * * * Else
* * * * * * * *SourceCol = SourceCol + 1
* * * * * * End If
* * * * *End If
* * * Next Cell
* *Next MyRow
* *Application.ScreenUpdating = True
End Sub

"Abdul" wrote:
The following code helps to copy to Visible Cells Only.

What I need is to select any one of *the open workbook using a
combobox and select a range (visible Cells Only) using Refedit and
copy the data and through same combobox and Refedit or another
combobox and Refedit select the destination workbook and cell and
paste the copied data to the visible cells only.

Any Help Please....

Option Explicit
Public StartWB As Workbook
Public StartWS As Worksheet
Public CopyRng As String

Public Sub CopyToVisibleOnly1()
'Start with cell selected that you want to copy.
Set StartWB = ActiveWorkbook
Set StartWS = ActiveSheet
CopyRng = Selection.Address
'Call CopyToVisibleOnly2 after a five-second delay.
Application.OnTime Now() + TimeValue("0:00:04"), "CopyToVisibleOnly2"
End Sub

Private Sub CopyToVisibleOnly2()
'Declare local variables.
Dim EndWB As Workbook, EndWS As Worksheet
Dim Target As Range, CurrCell As Range
Dim x As Long, FromCnt As Long
On Error GoTo CTVOerr
'Select the range where it should be pasted.
Set Target = Application.InputBox _
(Prompt:="Select the first cell in the Paste range", Type:=8)
Set EndWB = ActiveWorkbook
Set EndWS = ActiveSheet
Set CurrCell = Target.Cells(1, 1)
Application.ScreenUpdating = False
'Copy the cells from the original workbook, one at a time.
StartWB.Activate
StartWS.Activate
For x = 1 To Range(CopyRng).Count
StartWB.Activate
StartWS.Activate
Range(CopyRng).Cells(x, 1).Copy
'Return to the target workbook.
EndWB.Activate
EndWS.Activate
CurrCell.Activate
'Only cells in visible rows in the selected
'range are pasted.
Do While (CurrCell.EntireRow.Hidden = True) Or _
(CurrCell.EntireColumn.Hidden = True)
Set CurrCell = CurrCell.Offset(1, 0)
Loop
CurrCell.Select
ActiveSheet.Paste
Set CurrCell = CurrCell.Offset(1, 0)
Next x
Cleanup:
'Free the object variables.
Set Target = Nothing
Set CurrCell = Nothing
Set StartWB = Nothing
Set StartWS = Nothing
Set EndWB = Nothing
Set EndWS = Nothing
Application.ScreenUpdating = True
Exit Sub
CTVOerr:
MsgBox Err.Description
GoTo Cleanup
End Sub