Copy certain rows and columns using VBA

[sjfir]

Hi,
I have the following code in a sheet that currently copies all rows with a 1 in column F to another worksheet.

Dim LR As Long, i As Long
With Sheets("Jan")
LR = .Range("F" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Range("F" & i).Value = 1 Then .Rows(i).copy Destination:=Sheets("Matrix input sheet").Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i
End With

However what I'd really like the code to do is only copy the data from columns A-E in the Jan sheet and nothing else and that once it copies it selects the next empty cell in column A in the 2nd sheet

Any help much appreciated, thanks.

 

[slinky]

At the moment you're copying row by row, I'd probably go down the route of applying a filter, then copying the visible cells to the new sheet. It would probably run a touch faster with that method.
Something like this;
Range("A1:E" & ActiveSheet.UsedRange.Row).select
Selection.AutoFilter Field:=6, Criteria1:=1, Operator:=xlAnd
Range("A1:E" & ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible).copy

Note, that isn't tested at all!

 

[sjfir]

Thanks for the reply, that didn't work, I keep getting a run time error as it is only the top two rows that it seems to be trying to copy. Any ideas?

 

[slinky]

Is it a contiguous block of data?

 

[Michael M]

MAybe this...
Also, when posting code can you please use code tags. It's easier to read and debug

Sub MM1()
Dim LR As Long, i As Long
With Sheets("Jan")
LR = .Range("F" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Range("F" & i).Value = 1 Then .Range("A" & i & ":E" & i).Copy Destination:=Sheets("Matrix input sheet").Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i
End With

End Sub

 

[sjfir]

Thanks that worked great.