+ Reply to Thread
Results 1 to 42 of 42

Exporting

Hybrid View

  1. #1
    Forum Expert JBeaucaire's Avatar
    Join Date
    03-21-2004
    Location
    Bakersfield, CA
    MS-Off Ver
    2010, 2016, Office 365
    Posts
    33,492

    Re: Exporting

    1) Don't merge cells. There's no reason to merge columns S:Z to make wide cells when simply widening column S does the same thing. Merging cells on sheets you want to run macros on just makes more unnecesssary work.

    I unmerged them and widened column S.

    2) The unused cells in column A have to be empty for this to work properly. Right now, there is a hidden character in cell A5 that is messing it up. I'm sure it was accidental, but be aware.

    3) Here's a regular macro version, goes in a standard module:
    Option Explicit
    Option Compare Text
    
    Sub Transfer()
    'JBeaucaire  1/19/2010
    'Transfer items marked "y" in column F to monthly sheets
    'verify items have not been transferred previously
    
    Dim RNG As Range, cell As Range, rFind As Range, mSh As Worksheet, dSh As Worksheet
    Dim cName As String, Val As String, NR As Long, r As Long
    
    Set RNG = ActiveSheet.Range("F:F").SpecialCells(xlCellTypeConstants, 2)
    Set dSh = ActiveSheet
    
    For Each cell In RNG
        If cell = "y" Then
            'Create sheet if necessary, get account name and row number
                r = cell.Row
                cName = Range("B" & r).Text
                Val = Cells(r, "A").End(xlUp).Text
                On Error Resume Next
                If Not Evaluate("ISREF(" & Val & "!A1)") Then
                    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Val
                    dSh.Activate
                    Set mSh = Sheets(Val)
                    Range("A4:Q4").Copy
                    mSh.Range("A1").PasteSpecial (xlPasteAll)
                    mSh.Range("A1").PasteSpecial (xlPasteColumnWidths)
                    mSh.Range("D:E,G:H").EntireColumn.Delete xlShiftToLeft
                Else
                    Set mSh = Sheets(Val)
                End If
            
            'verify ACCOUNT/JOB NAME does not already exist on that sheet
            Set rFind = mSh.Range("B:B").Find(cName, After:=[B1], LookIn:=xlValues, LookAt:=xlWhole)
    
            If rFind Is Nothing Then
                NR = mSh.Range("B" & Rows.Count).End(xlUp).Row + 1
            Else
                GoTo Next1
            End If
            
            Set rFind = Range("A" & r & ":C" & r & ",F" & r & ",I" & r & ":Q" & r)
            rFind.Copy mSh.Range("A" & NR)
            mSh.Range("A" & NR) = dSh.Name
        End If
    Next1:
    Next cell
    
    With mSh.Range("A1").CurrentRegion
        .Sort Key1:=mSh.Range("A2"), Order1:=xlAscending, Key2:=mSh.Range("B2"), _
            Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
        .Borders.Weight = xlThin
    End With
    
    Beep
    End Sub
    4) Open the FORMS toolbar and add a form button, assign the macro "Transfer" to it. Use the button to initiate the transfers.
    Attached Files Attached Files
    Last edited by JBeaucaire; 01-19-2010 at 07:08 PM.
    _________________
    Microsoft MVP 2010 - Excel
    Visit: Jerry Beaucaire's Excel Files & Macros

    If you've been given good help, use the icon below to give reputation feedback, it is appreciated.
    Always put your code between code tags. [CODE] your code here [/CODE]

    ?None of us is as good as all of us? - Ray Kroc
    ?Actually, I *am* a rocket scientist.? - JB (little ones count!)

  2. #2
    Registered User
    Join Date
    12-28-2009
    Location
    USA
    MS-Off Ver
    Excel 2003
    Posts
    98

    Re: Exporting

    that works to perfection...I thank you very much for all of the amazing help.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1