Copy selected cells (with filter on) instead of the whole like

[Aquila61]

Hi guys

really long time not posting here, you know change in works, family... usual things!

got a probelm now hope you can help me about

(please note I know very little about VBA but I'm a good "copier"!!!!)

I have following code (clearly copied from the net, that's why I'm not able to solve my problem) that copies a selection from a workbook into another workbook after having inserted x number of rows. The main problem is that this code copies the whole line, while I need only the selected cells (ie from G to AA). the main issue I have/had is/was with filters, I've managed to get is almost work....!

here is the code (remember filter is on, so rows are not sequential)

Sub CopyFilter()
Dim Rng As Range
Dim rng2 As Range
Dim rng3 As Range
Dim aRng
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else

Set rng3 = ActiveSheet.AutoFilter.Range

b = rng3.Columns(1). _
SpecialCells(xlCellTypeVisible).Count - 1

'MsgBox rng.Columns(1). _
SpecialCells(xlCellTypeVisible).Count - 1 _
& " of " & rng _
.Rows.Count - 1 & " Records"
'MsgBox "" & b

Workbooks("XXXXX").Activate
Range("a12").Activate

aRng = b
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(aRng, 0)).Select

Selection.EntireRow.Insert
Range("a13").Activate

'Set Rng = ActiveSheet.AutoFilter.Range
rng3.Offset(1, 0).Resize(rng3.Rows.Count - 1).Copy _
Destination:=Worksheets("XXXXXS1").Range("A13")


End If
End Sub


Thanks guys and have a nice day!!