Only copy visible range in VBA?

后端 未结 4 1879
情话喂你
情话喂你 2021-01-15 12:52

I\'m running into an issue where I\'m unable to copy only visible cells to a new sheet. I\'m able to get the lastrow, but I get #N/A on every cell except the first for each

4条回答
  •  再見小時候
    2021-01-15 13:36

    Something like .Value2 = .Value doesn't work on special cells of type visible, because …

    … e.g. if lastRow = 50 and there are hiddenRows = 10 then …

    • your source Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible)
      has lastRow - hiddenRows = 40 rows
    • but your destination Range("A1:A" & lastRow).Value2
      has lastRow = 50 rows.

    On the first you subtract the visible rows, so they are different in size. Therefore .Value2 = .Value doesn't work, because you cannot fill 50 rows with only 40 source rows.

    But what you can do is Copy and SpecialPaste

    Option Explicit
    
    Sub Importe()
        Dim lastRow As Long
    
        lastRow = Worksheets("Sheet1").Cells(1, 1).SpecialCells(xlCellTypeVisible).End(xlDown).Row
    
        Worksheets.Add
    
        With ActiveSheet
           ActiveWorkbook.Worksheets("Sheet1").Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy
           .Range("A1").PasteSpecial xlPasteValues
    
           ActiveWorkbook.Worksheets("Sheet1").Range("E1:E" & lastRow).SpecialCells(xlCellTypeVisible).Copy
           .Range("B1").PasteSpecial xlPasteValues
        End With
    End Sub
    

    Nevertheless I recommend to avoid ActiveSheet or ActiveWorkbook if this is possible and reference a workbook eg by ThisWorkbook. My suggestion:

    Option Explicit
    
    Sub Importe()
        Dim SourceWs As Worksheet
        Set SourceWs = ThisWorkbook.Worksheets("Sheet1")
    
        Dim DestinationWs As Worksheet
        Set DestinationWs = ThisWorkbook.Worksheets.Add
    
        Dim lastRow As Long
        lastRow = SourceWs.Cells(1, 1).SpecialCells(xlCellTypeVisible).End(xlDown).Row
    
        SourceWs.Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy
        DestinationWs.Range("A1").PasteSpecial xlPasteValues
    
        SourceWs.Range("E1:E" & lastRow).SpecialCells(xlCellTypeVisible).Copy
        DestinationWs.Range("B1").PasteSpecial xlPasteValues
    End Sub
    

提交回复
热议问题