Report Macro

[Champers]

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

[Bob Phillips]

Caveat - emptor - completely untested



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

.Cells(cll.Row, "A").Resize(, 8).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

With ActiveCell

.Offset(1, 1).Copy
.Offset(0, 1).PasteSpecial
.Offset(1, 1).ClearContents
.Offset(1, -11).Select
Selection.EntireRow.Delete
Selection.EntireRow.Insert
End With
Loop

Range("A2:A3").Value = ""
End With

End Sub

[Champers]

That worked perfectly. :bow:

Thank you for your help.

[GTO]

Wow Bob, I had barely finished a 'howdy' ...

Mark

[Champers]

Hi,

Thanks for the welcome!!

As I am not able to post a wb example yet I will try and explain what I am trying to do.

I have a workbook that contains a number of sheets and two different reports with Jan - Dec worksheets. Hence the Jan, Jan (2), Jan (3).

When people use this workbook they will be able to pick report from the drop down list on Jan or Jan (2) that line from the report will then be pasted in to the Jan (3) work sheet.

It is basically a filter, however I have a number of people using different versions of the workbook and all of the Jan (3) - Dec (3) data will automatically populate into a master workbook that I currently have running with much more information.

The master workbook then acts as an overview sheet and populates graphs and transfers the data in to presentations in powerpoint.

I am not sure if that makes any sense!:dunno

I have only just started using the microsoft programmes, so learning as I go along! (Trial and Error) :doh:

[Champers]

Further to the thread above I am now trying to create an input box so that I do not have to create 24 different Macro's.

E.g. 12 for Jan -Dec report and another 12 for Jan (2) - Dec (2)

I am not sure how to go about this. I have tried recording a macro recording information in cell A3 and A4 which pick up the sheet name and then the column which report is in however it doesn't seem to like the copy and past function of it all.

Any ideas?:banghead:


Thanks

Champers

[Bob Phillips]

What code have you tried?

How do you differentiate between the 12s? ARe the sheets named Jan,Feb, etc.?

[Champers]

Hi,

I have tried using the following code:

Sheetvalue = Application.InputBox
Then Sheets (sheetvalue).select

The sheet names that I need to pull the row information from are:

Jan, Feb , March, April, May, June, July, August, September, October, November, December

And

Jan (2), Feb (2), March (2), April (2), May (2), June (2), July (2), August (2), September (2), October (2), November (2), December (2).

However I am trying to use it with the below Macro.

Sub Reportingtest()
Application.ScreenUpdating = False
With ActiveSheet

Range(Selection, Cells(ActiveCell.Row, 1)).Copy
Sheets("Jan (2)").Select
Range("A6: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 (2)")

For Each cll In Intersect(.UsedRange, .Columns("K"))

If InStr(UCase(cll.Value), "REPORT") > 0 Then

.Cells(cll.Row, "A").Resize(, 8).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

With ActiveCell

.Offset(1, 1).Copy
.Offset(0, 1).PasteSpecial
.Offset(1, 1).ClearContents
.Offset(1, -11).Select
Selection.EntireRow.Delete
Selection.EntireRow.Insert
End With
Loop

Range("A2:A3").Value = ""
End With

End Sub


I get what is going on, I just can't see how to link both?