Hi Everyone,
I am in need of copying filtered content from excel table and pasting it into another sheet below already existing data.
I am using below code but it doesn't work fine every time. The sheet where it pastes it shifts 1 row leaving a blank row after every code run.
Private Sub CopyScenario(ByVal TableName As String)
Dim TargetTable As ListObject
Dim NumberOfAreas As Long
Set TargetTable = ActiveSheet.ListObjects(TableName)
' Check
With TargetTable.ListColumns(1).Range
NumberOfAreas = .SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
Debug.Print NumberOfAreas
End With
If NumberOfAreas = 0 Then
''''
Else
Set ws = ThisWorkbook.Sheets("Saved Scenarios")
lrow = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'Pasting rows
Application.CutCopyMode = False
TargetTable.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("saved Scenarios").Range("A" & (lrow + 1))
Debug.Print lrow
End If
End Sub
I am in need of copying filtered content from excel table and pasting it into another sheet below already existing data.
I am using below code but it doesn't work fine every time. The sheet where it pastes it shifts 1 row leaving a blank row after every code run.
Private Sub CopyScenario(ByVal TableName As String)
Dim TargetTable As ListObject
Dim NumberOfAreas As Long
Set TargetTable = ActiveSheet.ListObjects(TableName)
' Check
With TargetTable.ListColumns(1).Range
NumberOfAreas = .SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
Debug.Print NumberOfAreas
End With
If NumberOfAreas = 0 Then
''''
Else
Set ws = ThisWorkbook.Sheets("Saved Scenarios")
lrow = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'Pasting rows
Application.CutCopyMode = False
TargetTable.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("saved Scenarios").Range("A" & (lrow + 1))
Debug.Print lrow
End If
End Sub
