Copy filtered data to new Excel workbook and prompt with Save As dialog

Question

I have a worksheet which contains some financial data to be transferred to accounting system.

Can say I know some things about programming, but Excel macros are little too much for me, so please suggest some (even partial) solutions to my problem. Thanks!

Master workbook columns are:

• Name
• Account
• Date
• Followup
• Amount
• Checked
• Transferred

Rows that I need to transfer have Checked="Yes" and Transferred=""

Output worksheet must have two rows for each row of master sheet(since credit and debet must be separated). Output columns must be:

• Date
• Account
• "8888"
• Followup
• Debet(=Amount)
• Credit(=empty)

After that Transferred column of master sheet needs to be set to "Pending", and SaveAs dialog is prompted for new workbook(possibly with some default name and path).

Thanks again!

Answer 1

seems to be an easy job which you would enjoy. To start just visit - http://www.ozgrid.com/Excel/free-training/basic-index.htm

If you need any specific help feel free to write..

Cheers..

Answer 2

Here's an example of how this can be done... left some stuff out but this should get you on your way.

Sub Transfer()

  Dim iRow As Long
  Dim iTotalRows As Long
  Dim iOutput As Long
  Dim wsMaster As Worksheet
  Dim wbNew As Workbook
  Dim wsOutput As Worksheet
  Dim sNewFile As String

 'the name of your source sheet
  Set wsMaster = ThisWorkbook.Worksheets("Master")

 'create your new target workbook 
  Set wbNew = Application.Workbooks.Add
  Set wsOutput = wbNew.Worksheets(1)
  wsOutput.Name = "Output"  'optional: name the output sheet

 'place your headings
  With wsOutput
     .Cells(1, 1) = "Date"
     .Cells(1, 2) = "Account"
     'etc
  End With

  iTotalRows = wsMaster.UsedRange.Rows.Count

 'assumes headings in row 1, so start scanning from row 2
  For iRow = 2 To iTotalRows

     'hard-coding the column positions here... not ideal but you can improve this bit
      If wsMaster.Cells(iRow, 6) = "Yes" And wsMaster.Cells(iRow, 7) = "" Then
         iOutput = iOutput + 2

         wsOutput.Cells(iOutput, 1) = wsMaster.Cells(iRow, 3) 'date
         wsOutput.Cells(iOutput + 1, 1) = wsMaster.Cells(iRow, 3) 'date again on the next row

         wsOutput.Cells(iOutput, 2) = wsMaster.Cells(iRow, 2) 'Account
         wsOutput.Cells(iOutput + 1, 2) = wsMaster.Cells(iRow, 2) 'Account again on the next row

        'etc

       'set pending flag
        wsMaster.Cells(iRow, 7) = "Pending"

      End If

  Next

 'prompt to save the new file: suggest a name with today's date encoded in it
  sNewFile = Application.GetSaveAsFilename("newFile" & Format(Now, "yymmdd") & ".xlsx")
  If sNewFile <> "" Then wbNew.SaveAs sNewFile

End Sub