Copy Visible Cells and paste in another workbook visible cells only
 

Hello!,

Is ther any macro to copy visible cells only from one workbook and
copy to another workbook only to the visible cells only?

For Eg: first the user select the workbook he wants and selects the
visible cells and press copy .. and the select another open workbook
of his choice and paste to the visible cells only starting from the
cell he selected???!!

Thanks

Copy Visible Cells and paste in another workbook visible cellsonly
 

Hello

Use something like this:

Sub test()
Range("A1:B100").SpecialCells(xlCellTypeVisible).C opy _
Destination:=Workbooks("Book2.xls"). _
Worksheets("Sheet1").Range("A1")
End Sub

Regards,
Per


On 1 Aug., 08:28, Abdul wrote:
Hello!,

Is ther any macro to copy visible cells only from one workbook and
copy to another workbook only to the visible cells only?

For Eg: first the user select the workbook he wants and selects the
visible cells and press copy .. and the select another open workbook
of his choice and paste to the visible cells only starting from the
cell he selected???!!

Thanks

Copy Visible Cells and paste in another workbook visible cellsonly
 

unfortunately it is not as staight and easy..

thuser shoul be able to select the workbook from a list (combobox) and
a range (may be esxternal) through Refedit and copy (through command
Button) and select another workbook (may be through another combobox)
and a range (may be through a second Refedit) and press paste (command
button). In both case ie. selection and paste should be limited to
visible cells only

Thanks

Copy Visible Cells and paste in another workbook visible cellsonly
 

unfortunately it is not as staight and easy..

thuser shoul be able to select the workbook from a list (combobox)
and
a range (may be esxternal) through Refedit and copy (through command
Button) and select another workbook (may be through another combobox)
and a range (may be through a second Refedit) and press paste
(command
button). In both case ie. selection and paste should be limited to
visible cells only


The following code will do it half way but noth theough Userform..

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

Copy Visible Cells and paste in another workbook visible cells
 

Hello Abdul,

Your comment; €œThe following code will do it half way but noth theough
Userform€�. I havent tested this with code but I think that you need to set
the Userform property ShowModal to False if you want to activate worksheets
while the form is open. Could this be the problem?

The code sample posted below will copy visible rows from one workbook to the
visible rows in another workbook.

Problems working with visible cells.
While you can copy visible cells only as a range, you can only paste them to
contiguous cells. (You cannot paste a range to just visible cells but I
assume from your posts that you already know that.)

You cant use code like for i = 1 to rows.count with visible rows because it
only counts rows within the first visible group of contiguous cells and that
makes it difficult to work with rows.

However, you can use For Each cel in Range. Therefore if you set the range
to one column only then For Each cel in Range combined with Offset can then
be used to address the row.

What the following code does.
Assigns the FIRST COLUMN of visible cells of the source UsedRange to a range
variable. It uses Offset to move the range down one row to exclude the column
headers. This then results in an extra row on the bottom and Resize is used
to reduce it by one row.

Assigns the number of columns in the UsedRange to a variable for use with
Offset.

Assigns the FIRST COLUMN of visible cells of the destination UsedRange to a
range variable. (See Offset and Resize as in previous sentence.)

Tests to see if there is sufficient visible rows in the destination
UsedRange to hold the source rows. (Note UsedRange includes both visible and
non visible rows.)

If not sufficient rows, assigns additional rows below the UsedRange to
another range variable and then uses Union to combine the ranges into the one
range variable.

Assigns the cell addresses of the destination column to an array.

Copies the source rows one at a time and pastes them to the destination
using the addresses from the array.

I am assuming from the code that you posted that you will be able to follow
this and edit it to your requirements and incorporate it with your Userform
data. Note in the example both workbooks need to be open with the code in the
source workbook (ThisWorkbook). It is up to you to change that to meet your
requirements.

Sub CopyVisibleCells()

Dim wbSource As Workbook
Dim wbDestin As Workbook

Dim wsSource As Worksheet
Dim wsDestin As Worksheet

Dim rngSource As Range
Dim rngDestin As Range
Dim rngDestin2 As Range

Dim lngTotCols As Long
Dim lngDestinDif As Long

Dim arrayRows()

Dim i As Long

Dim rngCel As Range

Set wbSource = ThisWorkbook

'Edit name of destination workbook
Set wbDestin = Workbooks("Visible Cells Destin.xls")

With wbSource
'Edit name of source worksheet
Set wsSource = .Sheets("Sheet1")
With wsSource.UsedRange
'Set rngSource to 1st column only
'Offset and resize moves down one row
'and reduces size by one row
'to exclude column headers.
Set rngSource = .Columns(1).Offset(1, 0) _
.Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)

lngTotCols = .Columns.Count
End With
End With

With wbDestin
'Edit name of destination worksheet
Set wsDestin = .Sheets("Sheet1")
With wsDestin.UsedRange
'Same methodology as setting rngSource
Set rngDestin = .Columns(1).Offset(1, 0) _
.Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)

'Test for sufficient rows in destination
'to hold source rows
lngDestinDif = rngDestin.Cells.Count _
- rngSource.Cells.Count

If lngDestinDif < 0 Then
'Insufficient visible rows in destination
'therefore add rows below UsedRange.
'Assumes all rows below UsedRange are visible.

'First cell below used range
Set rngDestin2 = .Cells(.Rows.Count + 1, 1)

'Convert to positive number
lngDestinDif = Abs(lngDestinDif) - 1

'Assign required extra rows to range variable
Set rngDestin2 = Range(rngDestin2, _
rngDestin2.Offset(lngDestinDif, 0))

'Combine both ranges
Set rngDestin = Union(rngDestin, rngDestin2)
End If

End With
End With

ReDim arrayRows(1 To rngDestin.Cells.Count)

i = 0
For Each rngCel In rngDestin
i = i + 1
arrayRows(i) = rngCel.Address
Next rngCel

i = 0
For Each rngCel In rngSource
i = i + 1
Range(rngCel, rngCel.Offset _
(0, lngTotCols - 1)).Copy _
Destination:= _
wsDestin.Range(arrayRows(i))

Next rngCel

End Sub

--
Regards,

OssieMac

Copy Visible Cells and paste in another workbook visible cells
 

Hello Abdul,

I am positng this again because i had an interconnect connection problem
earlier and it appears that it might not have posted so if it appears twice
then my apologies.

Your comment; €œThe following code will do it half way but noth theough
Userform€�. I havent tested this with code but I think that you need to set
the Userform property ShowModal to False if you want to activate worksheets
while the form is open. Could this be the problem?

The code sample below will copy visible rows from one workbook to the
visible rows in another workbook.

Problems working with visible cells.
While you can copy visible cells only as a range, you can only paste them to
contiguous cells. (You cannot paste a range to just visible cells but I
assume from your posts that you already know that.)

You cant use code like for i = 1 to rows.count with visible rows because it
only counts rows within the first visible group of contiguous cells and that
makes it difficult to work with rows.

However, you can use For Each cel in Range. Therefore if you set the range
to one column only then For Each cel in Range combined with Offset can then
be used to address the row.

What the following code does.
Assigns the FIRST COLUMN of visible cells of the source UsedRange to a range
variable. It uses Offset to move the range down one row to exclude the column
headers. This then results in an extra row on the bottom and Resize is used
to reduce it by one row.

Assigns the FIRST COLUMN of visible cells of the destination UsedRange to a
range variable. (See Offset and Resize as in previous sentence.)

Tests to see if there is sufficient visible rows in the destination
UsedRange to hold the source rows. (Note UsedRange includes both visible and
non visible rows.)

If not sufficient rows, assigns additional rows below the UsedRange to
another range variable and then uses Union to combine the ranges into the one
range variable.

Assigns the cell addresses of the destination column to an array.

Copies the source rows one at a time and pastes them to the destination
using the addresses from the array.

I am assuming from the code that you posted that you will be able to follow
this and edit it to your requirements and incorporate it with your Userform
data. Note in the example both workbooks need to be open with the code in the
source workbook (ThisWorkbook). It is up to you to change that to meet your
requirements.

Sub CopyVisibleCells()

Dim wbSource As Workbook
Dim wbDestin As Workbook

Dim wsSource As Worksheet
Dim wsDestin As Worksheet

Dim rngSource As Range
Dim rngDestin As Range
Dim rngDestin2 As Range

Dim lngTotCols As Long
Dim lngDestinDif As Long

Dim arrayRows()

Dim i As Long

Dim rngCel As Range

Set wbSource = ThisWorkbook

'Edit name of destination workbook
Set wbDestin = Workbooks("Visible Cells Destin.xls")

With wbSource
'Edit name of source worksheet
Set wsSource = .Sheets("Sheet1")
With wsSource.UsedRange
'Set rngSource to 1st column only
'Offset and resize moves down one row
'and reduces size by one row
'to exclude column headers.
Set rngSource = .Columns(1).Offset(1, 0) _
.Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)

lngTotCols = .Columns.Count
End With
End With

With wbDestin
'Edit name of destination worksheet
Set wsDestin = .Sheets("Sheet1")
With wsDestin.UsedRange
'Same methodology as setting rngSource
Set rngDestin = .Columns(1).Offset(1, 0) _
.Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)

'Test for sufficient rows in destination
'to hold source rows
lngDestinDif = rngDestin.Cells.Count _
- rngSource.Cells.Count

If lngDestinDif < 0 Then
'Insufficient visible rows in destination
'therefore add rows below UsedRange.
'Assumes all rows below UsedRange are visible.

'First cell below used range
Set rngDestin2 = .Cells(.Rows.Count + 1, 1)

'Convert to positive number
lngDestinDif = Abs(lngDestinDif) - 1

'Assign required extra rows to range variable
Set rngDestin2 = Range(rngDestin2, _
rngDestin2.Offset(lngDestinDif, 0))

'Combine both ranges
Set rngDestin = Union(rngDestin, rngDestin2)
End If

End With
End With

ReDim arrayRows(1 To rngDestin.Cells.Count)

i = 0
For Each rngCel In rngDestin
i = i + 1
arrayRows(i) = rngCel.Address
Next rngCel

i = 0
For Each rngCel In rngSource
i = i + 1
Range(rngCel, rngCel.Offset _
(0, lngTotCols - 1)).Copy _
Destination:= _
wsDestin.Range(arrayRows(i))

Next rngCel

End Sub

--
Regards,

OssieMac