VBA - PasteSpecial not working after using SpecialCells.Copy - vba

Question

To sum up, I try to copy some filtered data from a workbook A to a workbook B keeping the formatting of the workbook B.
Here is the relevant part of my code:
With originSheet
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
.SpecialCells(xlCellTypeVisible).Copy
End With
End With
destinationSheet.Range("B4").PasteSpecial xlPasteValues
The paste special is not working and this is the formatting of the workbook A that is used.
Solved:
The problem was that you can't use PasteSpecial in a discontinuous range.
So I went with the solution of Siddharth Rout to go through all the areas of the filtered range:
With originSheet
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
Set filteredRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
'~~> Loop through each area
For Each area In filteredRange.Areas
With destinationSheet
'~~> Find Next available row
lRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
area.Copy
destinationSheet.Range("B" & lRow).PasteSpecial xlPasteValues
End With
Next area
End With
End With

Answer 1

What #Jeeped has mentioned is very true that you cannot used Paste Special on a filtered range if they are Non Contiguous. However there is a way to achieve what you want :)
You have to loop through each area of the filtered range and then use Paste Special as shown below
Sub Sample()
Dim ws As Worksheet
Dim lastRowOriginSheet As Long
Dim filteredRange As Range, a As Range
Dim projectNumber As Long
'~~> I have set these for testing. Change as applicable
projectNumber = 1
Set ws = Sheet1
Set destinationSheet = Sheet2
lastRowOriginSheet = 16
With ws
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
Set filteredRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
'~~> Loop through each area
For Each a In filteredRange.Areas
With destinationSheet
'~~> Find Next available row
lRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
a.Copy
destinationSheet.Range("B" & lRow).PasteSpecial xlPasteValues
End With
Next a
End With
End With
End Sub
In Action

Answer 2

PasteSpecial does not work on a discontiguous range. If you have one hidden row in among visible rows then you have a discontiguous range. However, due to the nature of a discontiguous range, a straight copy and paste will paste formats and the values from formulas; i.e. it cannot determine how to shift the cell ranges in formulas so it just pastes values.
With originSheet
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
'you should probably check to ensure you have visible cells before trying to copy them
.SpecialCells(xlCellTypeVisible).Copy destination:=destinationSheet.Range("B4")
End With
End With

Answer 3

Try this. Instead of doing PasteSpecial, since you just need values, you can set the ranges equal to eachother.
Dim copyRng As Range
With originSheet
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
Set copyRng = .SpecialCells(xlCellTypeVisible)
End With
End With
' destinationSheet.Range("B4").Value = copyRng.Value
With destinationSheet
.Range(.Cells(4, 2), .Cells(4 + copyRng.Rows.Count - 1, 2 + copyRng.Columns.Count - 1)).Value = copyRng.Value
End With
(this is assuming your worksheet and lastRow and projectNumber are all declared properly and working).
Edited because if you just do Range("B4").Value = Range("A1:Z100").Value, it's only going to put the first value in your copied range in the cell. You need to expand the destination range to be the size of the copy range.