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

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
>

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 <J...@discussions.microsoft.com> 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

"Abdul" wrote:

> 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 <J...@discussions.microsoft.com> 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
>
>

Why doesn't work with a userform? Are some cells protected? You may have
to create an array of the cells you want to Copy

SourceArray = Array("A1","B2", "C3")


or

set SourceRange = Range("A1","B2","C3")

"Abdul" wrote:

> 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 <J...@discussions.microsoft.com> 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
>
>

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" <(E-Mail Removed)> wrote in message
news:472f3d1c-4fe2-4db6-ab39-(E-Mail Removed)...
> 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

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"
<rick.newsNO.S...@NO.SPAMverizon.net> 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" <abdulsalam.abdul...@gmail.com> wrote in message
>
> news:472f3d1c-4fe2-4db6-ab39-(E-Mail Removed)...
>
> > 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

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

Thanks Ossie,

As I have mentioned earlier I cant hard code the source or destination
workbook.

can you give me an example code where the user select the open
workbook through a ComboBox and the range through a RefEdit and user
select the destination workbook through a ComboBox and a Destination
Cell throug a RefEdit

This is the part I am stuck with.

Thanks again for your effort... ,


On Aug 2, 12:06*pm, OssieMac <Ossie...@discussions.microsoft.com>
wrote:
> 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 priorto
> 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

Hellow again Abdul,

Now I think I understand the problem better. Previously I thought that it
just was not working in conjunction with the Userform and that you knew how
to code the Userform part. However, a couple of questions first because I am
not sure how much code you really need.

Have you already populated the workbook names in the ComboBox lists (for
both Source and Destination)?

If you haven't done the above, is that what you also need help with? If so,
I need some information regarding a file filter like "Source*.xls" and
"Destination*.xls" so the correct files can be gathered for the lists.

Does the path have to be selected or can it be hard coded? (If hard coded
then I can mark that in the code for you to edit.)

If you have not already populated the workbook names in the ComboBox list
and you need the user to select both path and file name then perhaps I can
suggest using the Workbook Open dialog box and use a command button to invoke
it. The user can then select both the path and file name in the one
operation. Let me know your decision.

Do you want to be able to make all the selections on the form and then have
a separate command button to process it. Obviously the workbooks need to be
opened in the afterupdate event of the comboboxes so that the RefEdit
selections can be made. I prefer a button to execute the copy/paste code
after the selections are made because it gives the user a chance to review
the selections and make changes if necessary.

Will wait to hear from you.

--
Regards,

OssieMac