Hello Abdul,
Your comment; “The following code will do it half way but noth theough
Userformâ€. I haven’t 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 can’t 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
