View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Abdul[_2_] Abdul[_2_] is offline
external usenet poster
 
Posts: 137
Default Copy to Visible Cells only;Modify Code

Thanks for all the effort and replys.. as I mentioned I have this
working solution. But does your answer related to my question? where
is the user from involved here? I dont want to get a wait time for the
user. The user will be selecting the worksheet and range (can be
resttricted to one column) of his choice and the destination as well.
Of course both source and destination may contain hidden which i want
to avoid. Copying is simple but pasting is difficult.

Thanks again


On Aug 1, 7:20*pm, "Rick Rothstein"
wrote:
I think you code might be able to be made much simpler than what you are
using; but before I can know for sure, are your ranges *always* contiguous
or do you allow for non-contiguous ranges as well?

--
Rick (MVP - Excel)

"Abdul" wrote in message

...

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