Copy data from a filtered list to another filtered list

[martinequilibrium]

Dear Users,

I'm trying to copy a range of filtered cells to a destination range of other similar filtered cells.
Here is a little example I'm trying to use with some VBA code I found below.

Refering to http://answers.microsoft.com/en-us/...y/ebec7959-60bd-4903-ad8e-391f2f8d8479?page=3
Ibrahim Chakaleidos code.

Sub PasteToVisibleCellsOnly()
' 2016 Ibrahim Chakaleidos - *** Email address is removed for privacy ***
' Paste to visible cells only from clipboard or another sheet
' Compatible with Excel 2007, 2010


    Dim DataObj As MSForms.DataObject
    Dim strArray, strArray2
    Dim i As Long, j As Long
    Dim myString As String
    Dim Variable() As Variant


    Set DataObj = New MSForms.DataObject
    DataObj.GetFromClipboard
    myString = DataObj.GetText(1)
    strArray = Split(myString, vbNewLine)


' Paste party begins
    For i = LBound(strArray) To UBound(strArray)
        strArray2 = Split(strArray(i))


        For j = LBound(strArray2) To UBound(strArray2)
        ReDim Preserve Variable(j)
            Variable(j) = strArray2(j)


    Do Until ActiveCell.Offset(0, 0).EntireRow.Hidden = False
    ActiveCell.Offset(1, 0).Select
    Loop
ActiveCell.Value = Variable(j)
       ActiveCell.Offset(1, 0).Select
    Next j
    Next i


' This loop only to select the next visible cell after pasted data
      Do Until ActiveCell.Offset(0, 0).EntireRow.Hidden = False
    ActiveCell.Offset(1, 0).Select
    Loop


End Sub

I'm getting a:
Run-time error '-2147221404 (80040064)':
DataObject:GetText Estructura FORMATECT no válida

I do have the MsForms reference enabled.

Thanks!

 

[Akuini]

Try this:

Sub CopyVisibleToVisible()
'Copy paste(value):
'from filtered to filtered range
'from filtered to unfiltered range
'from unfiltered to filtered range
'Not work on hidden column

    Dim rngA As Range
    Dim rngB As Range
    Dim r As Range
    Dim Title As String
    Dim ra As Long
    Dim rc As Long
    
    Title = "Copy Visible To Visible"
    Set rngA = Application.Selection
    Set rngA = Application.InputBox("Copy Range :", Title, rngA.Address, Type:=8)
    
    Set rngB = Application.InputBox("Paste Range (select the first cell only):", Title, Type:=8)
    Set rngB = rngB.Cells(1, 1)
    Application.ScreenUpdating = False

    ra = rngA.Rows.count
    rc = rngA.Columns.count
    Set rngA = rngA.Cells(1, 1).Resize(ra, 1)
    
    For Each r In rngA.SpecialCells(xlCellTypeVisible)
      rngB.Resize(1, rc).Value = r.Resize(1, rc).Value
        Do
          Set rngB = rngB.Offset(1, 0)
        Loop Until rngB.RowHeight <> 0
    Next
    
    Application.Goto rngB
    Application.ScreenUpdating = True
    Application.CutCopyMode = False

End Sub

 

[martinequilibrium]

Sorry for the delay in the reply:
What an elegant and marvelous piece of code.
Thank you so much!
It does what asked and more and so simply coded. Thanks Akuini
You guys rock!

 

[Akuini]

Sorry for the delay in the reply:
What an elegant and marvelous piece of code.
Thank you so much!
It does what asked and more and so simply coded. Thanks Akuini
You guys rock!

You're welcome & thanks for the reply.