Only copy visible range in VBA?

后端 未结 4 1878
情话喂你
情话喂你 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:20

    To define whether a cell is visible or not, both its column and row should be visible. This means, that the .Hidden property of the column and the row should be set to False.

    Here is some sample code of how to copy only the visible ranges between two worksheets.

    Imagine that you have an input like this in Worksheets(1):

    Then you manually hide column B and you want to get in Worksheets(2) every cell from the Range(A1:C4), without the ones in column B. Like this:

    To do this, you should check each cell in the range, whether its column or row is visible or not. A possible solution is this one:

    Sub TestMe()
    
        Dim myCell  As Range
        For Each myCell In Worksheets(1).Range("A1:C4")
            If (Not Rows(myCell.Row).Hidden) And (Not Columns(myCell.Column).Hidden) Then
                Dim newCell As Range
                Set newCell = Worksheets(2).Cells(myCell.Row, myCell.Column)
                newCell.Value2 = myCell.Value2
            End If
        Next myCell    
    End Sub
    

    Just a general advise - whenever you use something like this Range("A1").Value2 = Range("A1").Value2 make sure that both are the same and not the left is Value2 and the right is .Value. It probably will not bring what you are expecting.

    0 讨论(0)
  • 2021-01-15 13:20

    You cannot perform a direct value transfer without cycling though the areas of the SpecialCells(xlCellTypeVisible) collection.

    Sometimes it is easier to copy everything and get rid of what you don't want.

    Sub Importe()
        Dim lr As Long
    
        Worksheets("Sheet1").Copy after:=Worksheets("Sheet1")
        With ActiveSheet
            .Name = "xyz"
            .Cells(1, 1).CurrentRegion = .Cells(1, 1).CurrentRegion.Value2
            For lr = .Cells(.Rows.Count, "A").End(xlUp).Row To 1 Step -1
                If .Cells(lr, "A").EntireRow.Hidden Then
                    .Cells(lr, "A").EntireRow.Delete
                End If
            Next lr
            lr = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Cells(1, 1).CurrentRegion.Resize(lr, 1) = .Cells(1, 1).CurrentRegion.Resize(lr, 1).Offset(0, 7).Value2
            .Cells(1, 1).CurrentRegion.Offset(0, 1).Resize(lr, 1) = .Cells(1, 1).CurrentRegion.Resize(lr, 1).Offset(0, 4).Value2
            .Columns("C:XFD").EntireColumn.Delete
        End With
    
    End Sub
    
    0 讨论(0)
  • 2021-01-15 13:32

    just to throw in an alternative version:

    Sub Importe()
        Dim sht1Rng As Range, sht1VisibleRng As Range
    
        With Worksheets("Sheet1")
            Set sht1Rng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
        End With
        Set sht1VisibleRng = sht1Rng.SpecialCells(xlCellTypeVisible)
    
        With Worksheets.Add
            .Range("A1").Resize(sht1Rng.Rows.Count).Value2 = sht1Rng.Offset(, 7).Value2
            .Range("B1").Resize(sht1Rng.Rows.Count).Value2 = sht1Rng.Offset(, 4).Value2
            .UsedRange.EntireRow.Hidden = True
            .Range(sht1VisibleRng.Address(False, False)).EntireRow.Hidden = False
        End With
    End Sub
    

    which may have the drawback of Address() maximum "capacity "

    0 讨论(0)
  • 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
    
    0 讨论(0)
提交回复
热议问题