Champers
06-16-2009, 03:00 AM
Hi Guys,
I have got the below Macro to take the data from one sheet to the next by looking up report in the "J" column and copying the entire row, however when it brings the data accross it drags the entire row. Can anybody suggest how I only drag columns A-H or how I could delete the columns that I do not want.
Any help would be much appreciated.
:dunno
Sub Reportingtest()
Application.ScreenUpdating = False
With ActiveSheet
Range(Selection, Cells(ActiveCell.Row, 1)).Copy
Sheets("Jan").Select
Range("A5:A150").Select
Do While ActiveCell > 0
lineno = lineno + 1
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Copy
ActiveCell.PasteSpecial
With ActiveWorkbook.Sheets("Jan")
For Each cll In Intersect(.UsedRange, .Columns("J"))
If InStr(UCase(cll.Value), "REPORT") > 0 Then
cll.EntireRow.Copy ActiveWorkbook.Sheets("Jan (3)").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next cll
End With 'activesheet
Do While ActiveCell.Offset(1, 0) > 0
ActiveCell.Offset(1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(1, 1).ClearContents
ActiveCell.Offset(1, 1).ClearContents
ActiveCell.Offset(1, 1).ClearContents
ActiveCell.Offset(1, 1).ClearContents
ActiveCell.Offset(1, 1).ClearContents
ActiveCell.Offset(1, -11).Select
Selection.EntireRow.Delete
Selection.EntireRow.Insert
Loop
Range("A2:A3") = ""
End With
End Sub
I have got the below Macro to take the data from one sheet to the next by looking up report in the "J" column and copying the entire row, however when it brings the data accross it drags the entire row. Can anybody suggest how I only drag columns A-H or how I could delete the columns that I do not want.
Any help would be much appreciated.
:dunno
Sub Reportingtest()
Application.ScreenUpdating = False
With ActiveSheet
Range(Selection, Cells(ActiveCell.Row, 1)).Copy
Sheets("Jan").Select
Range("A5:A150").Select
Do While ActiveCell > 0
lineno = lineno + 1
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Copy
ActiveCell.PasteSpecial
With ActiveWorkbook.Sheets("Jan")
For Each cll In Intersect(.UsedRange, .Columns("J"))
If InStr(UCase(cll.Value), "REPORT") > 0 Then
cll.EntireRow.Copy ActiveWorkbook.Sheets("Jan (3)").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next cll
End With 'activesheet
Do While ActiveCell.Offset(1, 0) > 0
ActiveCell.Offset(1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(1, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(1, 1).ClearContents
ActiveCell.Offset(1, 1).ClearContents
ActiveCell.Offset(1, 1).ClearContents
ActiveCell.Offset(1, 1).ClearContents
ActiveCell.Offset(1, 1).ClearContents
ActiveCell.Offset(1, -11).Select
Selection.EntireRow.Delete
Selection.EntireRow.Insert
Loop
Range("A2:A3") = ""
End With
End Sub