+ Reply to Thread
Results 1 to 3 of 3

Macro 2 Extract Data 2 Paste in New Wksht

  1. #1
    Registered User
    Join Date
    05-20-2005
    Location
    Oklahoma City
    Posts
    4

    Question Macro 2 Extract Data 2 Paste in New Wksht

    undefined

    Each morning a spreadsheet is sent to various regional managers - The person who generates this just creates another row - It is sorted by date - and separated by an empty row.

    So I may have two rows with column "A" as a date, "B" as a problem, "C" as something else, "D" as a region...etc. Then a blank or empty row, then the yesterday's section..there may have been 3 or 4 rows of data...and so on...

    So...what I have been doing manually is to search for the empty rows and delete all but the last one...

    Then I do an AutoFilter...

    Then I sort Column "D" - Region - one region at a time ( I am responsible for 15 or so ) once it's sorted for a specific region - I select the entire series of rows pertaining to that region and copy and paste to a separate worksheet in the same workbook for that region.

    I wasn't sure where to start...I was trying to create a macro...one at a time and then maybe I could put them altogether...and create one complete macro...first to eliminate those empty rows..all but the last one...

    I would really appreciate any assistance anyone could offer...
    JP2R =:^)

  2. #2
    Dave Ramage
    Guest

    RE: Macro 2 Extract Data 2 Paste in New Wksht

    Try this...

    Sub SplitRegions()
    '''Splits data on active sheet into separate sheets based on data in column D
    ' Only values in column D matching the list in columnA of Sheet "List" will
    be coppied
    Const cNumSourceColumns As Integer = 4

    Dim rngRegionList As Range, rngR As Range, rngList As Range
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim lLastRow As Long

    Set wsSource = ActiveSheet

    'get last row in source sheet
    lLastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    'sort the data by date, then problem
    wsSource.Range("A1").Resize(lLastRow, cNumSourceColumns).Sort
    key1:=wsSource.Range("A1"), key2:=wsSource.Range("B1"), header:=xlYes '
    change 4 to required number of columns
    'blank rows now sorted to bottom, so get new last row
    lLastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    Set rngList = wsSource.Range("A1").Resize(lLastRow, cNumSourceColumns)

    'find list of Regions to extract and loop through
    Set rngRegionList =
    ThisWorkbook.Sheets("List").Range("A1").Resize(ThisWorkbook.Sheets("List").Cells(ThisWorkbook.Sheets("List").Rows.Count, 1).End(xlUp).Row, 1)
    For Each rngR In rngRegionList
    rngList.AutoFilter field:=4, Criteria1:=rngR.Formula
    Set wsDest = ActiveWorkbook.Worksheets.Add
    wsDest.Name = rngR.Formula
    rngList.Copy Destination:=wsDest.Range("A1")
    Next rngR
    wsSource.AutoFilterMode = False
    End Sub

    Cheers,
    Dave

    "JP2R" wrote:

    >
    > undefined
    >
    > Each morning a spreadsheet is sent to various regional managers - The
    > person who generates this just creates another row - It is sorted by
    > date - and separated by an empty row.
    >
    > So I may have two rows with column "A" as a date, "B" as a problem, "C"
    > as something else, "D" as a region...etc. Then a blank or empty row,
    > then the yesterday's section..there may have been 3 or 4 rows of
    > data...and so on...
    >
    > So...what I have been doing manually is to search for the empty rows
    > and delete all but the last one...
    >
    > Then I do an AutoFilter...
    >
    > Then I sort Column "D" - Region - one region at a time ( I am
    > responsible for 15 or so ) once it's sorted for a specific region - I
    > select the entire series of rows pertaining to that region and copy and
    > paste to a separate worksheet in the same workbook for that region.
    >
    > I wasn't sure where to start...I was trying to create a macro...one at
    > a time and then maybe I could put them altogether...and create one
    > complete macro...first to eliminate those empty rows..all but the last
    > one...
    >
    > I would really appreciate any assistance anyone could offer...
    >
    >
    > --
    > JP2R
    >
    >
    > ------------------------------------------------------------------------
    > JP2R's Profile: http://www.excelforum.com/member.php...o&userid=23582
    > View this thread: http://www.excelforum.com/showthread...hreadid=385125
    >
    >


  3. #3
    Registered User
    Join Date
    05-20-2005
    Location
    Oklahoma City
    Posts
    4

    Thanks So Much!

    I really appreciate this...wow!

+ 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