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

Hello Abdul,

I posted put some code on a previous post of your relating to this but here
is a modified version. It will run from a Userform but you should set the
Userform ShowModal property to False.

The code and userform can be in any workbook. It does not necessarily have
to be in the Source data or Destination data workbook.

It works for Hidden rows only. Have done nothing with hidden columns.

You will have to edit the code to set the wbSource and wbDestin workbook
variables. You might want to do this with additional code to be run prior to
the InputBoxes but both the Source and Destination workbooks need to be open
before the code gets to the Inputboxes.

With the first InputBox simply select the full range to be copied. Does not
matter if it appears to include hidden rows because the code will exclude
hidden rows.

With the second InputBox select the first visible cell only of the
destination. The code will handle identifying the required visible cells for
the paste. It pastes one row at a time.

Private Sub CopyVisibleData_Click()

Dim wbSource As Workbook
Dim wbDestin As Workbook
Dim rngSource As Range
Dim rngDestin As Range
Dim lngTotCols As Long
Dim DestinOffset()
Dim i As Long
Dim j As Long
Dim rngCel As Range

'NOTE: Code works from any workbook,
'or stand alone workbook.
Set wbSource = Workbooks("Visible Cells Source.xls")
Set wbDestin = Workbooks("Visible Cells Destin.xls")

'Must activate required workbook before
'InputBox code.
wbSource.Activate

On Error Resume Next
Set rngSource = Application.InputBox _
(prompt:="Select Source Range to Copy", _
Title:="Source Selection", Type:=8)
On Error GoTo 0

If rngSource Is Nothing Then
MsgBox "User clicked Cancel." & vbCrLf & _
"Processing terminated."
Exit Sub
End If

'Save the total number of columns for Offset
lngTotCols = rngSource.Columns.Count

'Alter selection to one column only and
'Exclude hidden cells from the selected range.
'Selecting one row only results in entire
'column to bottom of page being assigned
'to rngSource and hense the If/Else/End If.
If rngSource.Rows.Count 1 Then
Set rngSource = rngSource.Columns(1) _
.SpecialCells(xlCellTypeVisible)
Else
Set rngSource = rngSource.Cells(1, 1)
End If

'Must activate required workbook before
'InputBox code.
wbDestin.Activate

DestinSelect:
On Error Resume Next
Set rngDestin = Application.InputBox _
(prompt:="Select destination workbook and worksheet" _
& vbCrLf & "Select FIRST cell only of destination", _
Title:="Destination Selection", Type:=8)
On Error GoTo 0

If rngDestin Is Nothing Then
MsgBox "User clicked Cancel." & vbCrLf & _
"Processing terminated."
Exit Sub
End If

If rngDestin.Cells.Count < 1 Then
MsgBox "Must select one visible cell only"
GoTo DestinSelect
End If

'Create array of destination offsets.
ReDim DestinOffset(1 To rngSource.Cells.Count)

i = 0 'Initialize
j = 0 'Initialize
Do
If rngDestin.Offset(j) _
.EntireRow.Hidden = False Then
i = i + 1
DestinOffset(i) = j
End If
j = j + 1
Loop While i < UBound(DestinOffset)

'Copy and paste the rows from source
'to the destination.
i = 0 'Initialize
For Each rngCel In rngSource
i = i + 1
Range(rngCel, rngCel.Offset _
(0, lngTotCols - 1)).Copy _
Destination:=rngDestin _
.Offset(DestinOffset(i))
Next rngCel

End Sub

--
Regards,

OssieMac