Copy non-hidden rows

[sofas]

Welcome. I am trying to copy only the non-hidden rows, but I have not succeeded. I hope to find someone to help me with this. Thanks in advance.

Sub test()

Set f = Sheets("Essai1")

Set d = CreateObject("Scripting.Dictionary")

a = f.Range("A2:f" & f.[A65000].End(xlUp).Row).SpecialCells(xlCellTypeVisible).Value

  For I = LBound(a) To UBound(a)

     d(I) = Array(a(I, 2), a(I, 5), a(I, 6))

  Next I

  b = Application.Transpose(Application.Transpose(d.items))

  Sheet1.[A2].Resize(UBound(b), UBound(b, 2)) = b

End Sub

Just an addition
With the ability to specify the columns in which you want to place data, if possible

 

[Alex Blakenburg]

I don't know what I am missing here but your dictionary key is just the row identifier so it is always going to be unique, so the dictionary isn't doing anything.
You can also not load a non-contiguous range into an array it will only load the first Range Area and ignore the rest.
(Note: I have used xlPasteValuesAndNumberFormats because it correctly shows dates, change it to just xlPasteValues if you prefer that)

See if this helps:

Sub CopyVisibleCellsOnly()
    Dim srcSht As Worksheet, destSht As Worksheet
    Dim firstRow As Long, lastRow As Long, srcColArr As Variant, destColArr As Variant
    Dim visRng As Range
    Dim i As Long
    
    Application.ScreenUpdating = False
    Set srcSht = Worksheets("Essai1")
    Set destSht = Worksheets("Sheet1")
    
    firstRow = 2
    lastRow = srcSht.Range("F" & Rows.Count).End(xlUp).Row
    srcColArr = Array(2, 5, 6)              ' Columns to copy
    destColArr = Array(1, 2, 3)             ' Matching columns to copy to
    
    For i = 0 To UBound(srcColArr)
        With srcSht
            Set visRng = .Range(.Cells(firstRow, srcColArr(i)), .Cells(lastRow, srcColArr(i))).SpecialCells(xlCellTypeVisible)
            
            visRng.Copy
                destSht.Cells(2, destColArr(i)).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        End With
    
    Next i
    Application.ScreenUpdating = True
End Sub

 

[sofas]

I don't know what I am missing here but your dictionary key is just the row identifier so it is always going to be unique, so the dictionary isn't doing anything.
You can also not load a non-contiguous range into an array it will only load the first Range Area and ignore the rest.
(Note: I have used xlPasteValuesAndNumberFormats because it correctly shows dates, change it to just xlPasteValues if you prefer that)

See if this helps:

Sub CopyVisibleCellsOnly()
    Dim srcSht As Worksheet, destSht As Worksheet
    Dim firstRow As Long, lastRow As Long, srcColArr As Variant, destColArr As Variant
    Dim visRng As Range
    Dim i As Long
   
    Application.ScreenUpdating = False
    Set srcSht = Worksheets("Essai1")
    Set destSht = Worksheets("Sheet1")
   
    firstRow = 2
    lastRow = srcSht.Range("F" & Rows.Count).End(xlUp).Row
    srcColArr = Array(2, 5, 6)              ' Columns to copy
    destColArr = Array(1, 2, 3)             ' Matching columns to copy to
   
    For i = 0 To UBound(srcColArr)
        With srcSht
            Set visRng = .Range(.Cells(firstRow, srcColArr(i)), .Cells(lastRow, srcColArr(i))).SpecialCells(xlCellTypeVisible)
           
            visRng.Copy
                destSht.Cells(2, destColArr(i)).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        End With
   
    Next i
    Application.ScreenUpdating = True
End Sub

As we are always used to from you. Great solution. Thank you very much .

 

[Alex Blakenburg]

You're welcome. Appreciate the feedback.

 

[Alex Blakenburg]

PS: just add this to the end just before turning screenupdating back to True.

Application.CutCopyMode = False