View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default Copy to Visible Cells only;Modify Code

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