Solved: Collating and formatting financial data

[alexnicholas]

Hi

I'm sure most of you will be able to do this in your sleep and have probably answered this sort of question already. I've attempted to create a macro to solve my problem but unfortunately I'm not having much luck and just end up doing it manually every time.

I have 2 worksheets with detailed financial data on, that I need to collate into one worksheet that holds a subset of the data.
So I need a macro that will do the following:

- create a blank worksheet with a set of standard column headings i.e service, category, item, year 1, year 2, etc (example of a manually completed DATA worksheet included in the xls)

- on each row starting at row 9, copy the values/text from columns, which I have highlighted in yellow/green along that row, only if column T on otherexpenses and AD on staffingplan has a value in it +- but not 0 or blank.

- then paste the data into the blank worksheet under the headings

The idea is to keep the original data the same and just copy and paste the rows and columns i need so that I can create a pivot table to analysis it.

Thanks in advance for your help

[mdmackillop]

Hi Alex,
Welcome to VBAX
Here's some code for most of it. I'll leave you to complete the headers.
[vba]
Option Explicit
Sub GetData()
Dim cel As Range, Rw As Long
Rw = 2
Application.ScreenUpdating = False
Sheets.Add
ActiveSheet.Name = "DATA"
Cells(1, 1) = "Service Line"
Cells(1, 2) = "Tower"
Cells(1, 3) = "Source"
'to be completed

With Sheets("staffingplan")
For Each cel In .Range(.Cells(9, 3), .Cells(Rows.Count, 3).End(xlUp))
If .Cells(cel.Row, "AD").Value > 0 Then
Rw = Rw + 1
cel.Resize(, 7).Copy Cells(Rw, "A")
cel.Offset(, 8).Resize(, 2).Copy Cells(Rw, "H")
cel.Offset(, 30).Resize(, 11).Copy Cells(Rw, "AG")
cel.Offset(, 165).Resize(, 11).Copy Cells(Rw, "K")
cel.Offset(, 177).Resize(, 11).Copy Cells(Rw, "V")
End If
Next
End With
With Sheets("otherexpenses")
For Each cel In .Range(.Cells(9, 3), .Cells(Rows.Count, 3).End(xlUp))
If .Cells(cel.Row, "T").Value > 0 Then
Rw = Rw + 1
cel.Resize(, 6).Copy Cells(Rw, "A")
cel.Offset(, 6).Copy Cells(Rw, "H")
cel.Offset(, 7).Copy Cells(Rw, "J")
cel.Offset(, 155).Resize(, 11).Copy Cells(Rw, "K")
cel.Offset(, 167).Resize(, 11).Copy Cells(Rw, "V")
End If
Next
End With
Application.ScreenUpdating = True
End Sub

[/vba]

[alexnicholas]

thanks mdmackillop this was excellent, saved me loads of time on copy and paste, it also lets other people to use it as well, thanks.