Copying multiple cells in same row based on multiple criteria - vba

Question

Background: I have an Excel file used for tracking credit card payables. There are 18 columns of data (A through R). Out of these 18 columns, I want to use a macro to filter for specific statement date and then for a specific company code.
Each company code will be assigned a new worksheet. In each of these worksheets, I want to bring over specific cells from the master worksheet based on the criteria. For instance, the macro should first sort for statement date (7/31/2012) and then company code (ABC). Then, I need to run a loop to bring over details. For instance, in the master worksheet, the GL code in column P needs to be copied to the "ABC" worksheet in column H.
Here's a summary of what needs to happen:
1. Clear any filters in filter range (A2:R2)
2. Filter for date in cell A1 on "Master" worksheet beginning in cell A3 (date column)
3. Filter for company code (ABC) in column O
That should give a data set for particular company's statement activity. Here's what needs to happen next:
4. Copy Column P cell values in "master" worksheet to Column C in "ABC" worksheet
5. Copy Column N cell values in "master" worksheet to Column D in "ABC" worksheet
6. Copy Column R cell values in "master" worksheet to Column H in "ABC" worksheet
7. Copy Column F cell values in "master" worksheet to Column G in "ABC" worksheet, but max of 30 characters
8. If Column G value in "master" worksheet is >=0, then copy that value to Column E in "ABC" worksheet (otherwise needs to be zero)
9. If column G value in "master" worksheet is <0, then copy that value to Column F in "ABC" worksheet (otherwise needs to be zero)
Is this possible?

Answer 1

Here's a sub that should get you started. I did not implement all your steps, but I believe this is enough to take and finish on your own. If you find this answer is helpful to get you where you need to go, please accept this answer. If you have problems with anything here, please add a comment to this answer asking for clarification.
I have only tested on dummy data, but what I did work with was successful.
Option Explicit
Sub TransferData()
Dim Master As Worksheet
Dim NewSheet As Worksheet
Dim CompanyList As Object
Dim lRow As Long, lMaxRow As Long, lNewRow As Long
Dim vDictItem As Variant
Set CompanyList = CreateObject("Scripting.Dictionary")
Set Master = ThisWorkbook.Sheets("Master")
If Master.FilterMode Then
Master.ShowAllData
End If
Master.Range("A:R").Sort Master.Range("A2"), xlAscending, Master.Range("O2"), , xlAscending, , , xlYes
lMaxRow = Master.Range("A" & Master.Rows.Count).End(xlUp).Row
For lRow = 3 To lMaxRow
If Not CompanyList.Exists(Master.Range("A" & lRow).Value) Then
CompanyList.Add Master.Range("A" & lRow).Value, Master.Range("A" & lRow).Value
End If
Next lRow
For Each vDictItem In CompanyList.Keys
Master.Range("A3:R" & lMaxRow).AutoFilter 1, vDictItem
If Master.Cells.SpecialCells(xlCellTypeVisible).Count > 0 Then
Set NewSheet = ThisWorkbook.Worksheets.Add
NewSheet.Name = vDictItem
lNewRow = 1
For lRow = 3 To lMaxRow
If Master.Rows(lRow).Hidden = False Then
lNewRow = lNewRow + 1
NewSheet.Range("C1").Value = Master.Range("P1").Value
NewSheet.Range("C" & lNewRow).Value = Master.Range("P" & lRow).Value
NewSheet.Range("G1").Value = Master.Range("F1").Value
NewSheet.Range("G" & lNewRow).Value = Left(Master.Range("F" & lRow).Value, 30)
NewSheet.Range("E1").Value = Master.Range("G1").Value & " (POS)"
NewSheet.Range("F1").Value = Master.Range("G1").Value & " (NEG)"
If Master.Range("G" & lRow).Value >= 0 Then
NewSheet.Range("E" & lNewRow).Value = Left(Master.Range("G" & lRow).Value, 30)
Else
NewSheet.Range("F" & lNewRow).Value = Left(Master.Range("G" & lRow).Value, 30)
End If
End If
Next lRow
End If
Next vDictItem
End Sub