Excel '07 Macro for sorting and copying data

Microsoft Office excel 2007 home & stude...
September 20, 2010 at 08:30:26
Specs: Windows XP
I have been scouring site after site and googling like crazy to find the type of info I have seen here. Great help guys.

I am attempting to sort data from worksheet 1 and copy it over to 26 existing different worksheets. I want to keep the info on sheet 1 available and have it copy and pasted based on information in column E. Column E would reflect names of workplaces for those 26 other worksheets (already named).

From what I have seen Derby and Humar have been a huge help and really appreciate any help you or anyone else can give me.

(Sorry if I left room for question on the goal. 1st time posting forums for tech help.)


See More: Excel 07 Macro for sorting and copying data

Report •


#1
September 20, 2010 at 22:56:00
This thread here is pretty much what I am looking for (from what I read). I attempted to modify it for my needs with no luck whatsoever...

http://www.computing.net/cgi-bin/my...

I changed references to worksheets and source page information and probably things I should not have. (reason why I am still watching it do the same thing it has been for the last week... lol)


Report •

#2
September 21, 2010 at 11:13:13
To be more clear as I have been reading more and more codes on this site:

- The "source" sheet will be the collection point and will retain all data inputted.
- The destination sheets (25 of them) will receive the inputted data as it is keyed into the source dependent on column E (work site). The sheets are created and named.
- I have ran a =if in column "F" for date expiration (should this matter)
- Also I would love for data from column "F" once 1 yr old to move (no retention of data from source sheets) all data from all sheets to a void sheet. (Not created but can no problem.) (Very optional). I have taken a VBA from a previous post and came up with this: (Not pretty and probably not close to correct.)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'stop changes made by this macro from re-triggering it
Application.EnableEvents = False

On Error GoTo ErrHnd

Dim intStatusCol As Integer
'set status column (E=2 E=21 etc.)
intStatusCol = 21

'test if changed cell is in status column
If Target.Column = intStatusCol Then
'a status change has occurred
Dim rngCell As Range
Dim rngStart As Range
Dim rngEnd As Range
Dim intNASoffst As Integer
Dim intVAQ129offst As Integer
Dim intVAQ130offst As Integer
Dim intVAQ131offst As Integer
Dim intVAQ132offst As Integer
Dim intVAQ133offst As Integer
Dim intVAQ134offst As Integer
Dim intVAQ135offst As Integer
Dim intVAQ137offst As Integer
Dim intVAQ138offst As Integer
Dim intVAQ139offst As Integer
Dim intVAQ140offst As Integer
Dim intVAQ141offst As Integer
Dim intVAQ142offst As Integer
Dim intEAoffst As Integer
Dim intVQ1offst As Integer
Dim intVP1offst As Integer
Dim intVQ2offst As Integer
Dim intVP40offst As Integer
Dim intVP46offst As Integer
Dim intVR61offst As Integer
Dim intCHUoffst As Integer
Dim intCIVoffst As Integer
Dim intFIREoffst As Integer

'clear existing data
Worksheets("NASWI").Cells.Clear
Worksheets("VAQ-129").Cells.Clear
Worksheets("VAQ-130").Cells.Clear
Worksheets("VAQ-131").Cells.Clear
Worksheets("VAQ-132").Cells.Clear
Worksheets("VAQ-133").Cells.Clear
Worksheets("VAQ-134").Cells.Clear
Worksheets("VAQ-135").Cells.Clear
Worksheets("VAQ-137").Cells.Clear
Worksheets("VAQ-138").Cells.Clear
Worksheets("VAQ-139").Cells.Clear
Worksheets("VAQ-140").Cells.Clear
Worksheets("VAQ-141").Cells.Clear
Worksheets("VAQ-142").Cells.Clear
Worksheets("EAWS").Cells.Clear
Worksheets("VQ-1").Cells.Clear
Worksheets("VP-1").Cells.Clear
Worksheets("VQ-2").Cells.Clear
Worksheets("VP-40").Cells.Clear
Worksheets("VP46").Cells.Clear
Worksheets("VR-61").Cells.Clear
Worksheets("CHUGACH").Cells.Clear
Worksheets("CIVILIAN-CONTRACTOR").Cells.Clear
Worksheets("FIRE DEPARTMENT").Cells.Clear
'set source data start row (in column E)
Set rngStart = Worksheets("Source").Range("E2")
'find end of source data (in column E)
Set rngEnd = Worksheets("Source"). _
Range("E" & CStr(Application.Rows.Count)).End(xlUp)

'set TWENTYFIVE destination row offsets
intNASoffst = 0
intVAQ129offst = 0
intVAQ130offst = 0
intVAQ131offst = 0
intVAQ132offst = 0
intVAQ133offst = 0
intVAQ134offst = 0
intVAQ135offst = 0
intVAQ137offst = 0
intVAQ138offst = 0
intVAQ139offst = 0
intVAQ140offst = 0
intVAQ141offst = 0
intVAQ142offst = 0
intEAoffst = 0
intVQ1offst = 0
intVP1offst = 0
intVQ2offst = 0
intVP40offst = 0
intVP46offst = 0
intVR61offst = 0
intCHUoffst = 0
intCIVoffst = 0
intFIREoffst = 0

'loop through source
'offset is one less than required column
For Each rngCell In Worksheets("Source").Range(rngStart, rngEnd)
Select Case rngCell.Offset(0, intStatusCol - 1).Text
'copy entire row to appropriate sheet
Case "NASWI"
rngCell.EntireRow.Copy _
Destination:=Worksheets("NASWI").Range("E2"). _
Offset(intNASoffst, 0)
intNASoffst = intNASoffst + 1
Case "VAQ-129"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VAQ-129").Range("E2"). _
Offset(intVAQ129offst, 0)
intVAQ129offst = intVAQ129offst + 1
Case "VAQ-130"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VAQ-130").Range("E2"). _
Offset(intVAQ130offst, 0)
intVAQ130offst = intVAQ130offst + 1
Case "VAQ-131"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VAQ-131").Range("A2"). _
Offset(intVAQ130offst, 0)
intVAQ130offst = intVAQ130offst + 1

'This is where I paused to see if it would work at all. you can see the .Range("A2") was not changed to reflect.

Case "VAQ-132"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VAQ-132").Range("A2"). _
Offset(intVAQ132offst, 0)
intVAQ132offst = intVAQ132offst + 1
Case "VAQ-133"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VAQ-133").Range("A2"). _
Offset(intVAQ133offst, 0)
intVAQ133offst = intVAQ133offst + 1
Case "VAQ-134"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VAQ-134").Range("A2"). _
Offset(intVAQ134offst, 0)
intVAQ134offst = intVAQ134offst + 1
Case "VAQ-135"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VAQ-135").Range("A2"). _
Offset(intVAQ135offst, 0)
intVAQ135offst = intVAQ135offst + 1
Case "VAQ-137"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VAQ-137").Range("A2"). _
Offset(intVAQ137offst, 0)
intVAQ137offst = intVAQ137offst + 1
Case "VAQ-138"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VAQ-138").Range("A2"). _
Offset(intVAQ138offst, 0)
intVAQ138offst = intVAQ138offst + 1
Case "VAQ-139"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VAQ-139").Range("A2"). _
Offset(intVAQ139offst, 0)
intVAQ139offst = intVAQ139offst + 1
Case "VAQ-140"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VAQ-140").Range("A2"). _
Offset(intVAQ140offst, 0)
intVAQ140offst = intVAQ140offst + 1
Case "VAQ-141"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VAQ-141").Range("A2"). _
Offset(intVAQ141offst, 0)
intVAQ141offst = intVAQ141offst + 1
Case "VAQ-142"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VAQ-142").Range("A2"). _
Offset(intVAQ142offst, 0)
intVAQ142offst = intVAQ142offst + 1
Case "EAWS"
rngCell.EntireRow.Copy _
Destination:=Worksheets("EAWS").Range("A2"). _
Offset(intEAoffst, 0)
intEAoffst = intEAoffst + 1
Case "VQ-1"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VQ-1").Range("A2"). _
Offset(intVQ1offst, 0)
intVQ1offst = intVQ1offst + 1
Case "VP-1"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VP-1").Range("A2"). _
Offset(intVP1offst, 0)
intVP1offst = intVP1offst + 1
Case "VQ-2"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VQ-2").Range("A2"). _
Offset(intVQ2offst, 0)
intVQ2offst = intVQ2offst + 1
Case "VP-46"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VP-46").Range("A2"). _
Offset(intVP46offst, 0)
intVP46offst = intVP46offst + 1
Case "VP-69"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VP-69").Range("A2"). _
Offset(intVP46offst, 0)
intVP46offst = intVP46offst + 1
Case "VR-61"
rngCell.EntireRow.Copy _
Destination:=Worksheets("VP-61").Range("A2"). _
Offset(intVR61offst, 0)
intVR61offst = intVR61offst + 1
Case "CHUGACH"
rngCell.EntireRow.Copy _
Destination:=Worksheets("CHUGACH").Range("A2"). _
Offset(intCHUoffst, 0)
intCHUoffst = intCHUoffst + 1
Case "CIVILIAN-CONTRACTOR"
rngCell.EntireRow.Copy _
Destination:=Worksheets("CIVILIAN-CONTRACTOR").Range("A2"). _
Offset(intCIVoffst, 0)
intCIVoffst = intCIVoffst + 1
Case "FIRE DEPARTMENT"
rngCell.EntireRow.Copy _
Destination:=Worksheets("FIRE DEPARTMENT").Range("A2"). _
Offset(intFIREoffst, 0)
intFIREoffst = intFIREoffst + 1
Case Else
'clear any partially copied data
Worksheets("NASWI").Cells.Clear
Worksheets("VAQ-129").Cells.Clear
Worksheets("VAQ-130").Cells.Clear
Worksheets("VAQ-131").Cells.Clear
Worksheets("VAQ-132").Cells.Clear
Worksheets("VAQ-133").Cells.Clear
Worksheets("VAQ-134").Cells.Clear
Worksheets("VAQ-135").Cells.Clear
Worksheets("VAQ-137").Cells.Clear
Worksheets("VAQ-138").Cells.Clear
Worksheets("VAQ-139").Cells.Clear
Worksheets("VAQ-140").Cells.Clear
Worksheets("VAQ-141").Cells.Clear
Worksheets("VAQ-142").Cells.Clear
Worksheets("EAWS").Cells.Clear
Worksheets("VQ-1").Cells.Clear
Worksheets("VP-1").Cells.Clear
Worksheets("VQ-2").Cells.Clear
Worksheets("VP-40").Cells.Clear
Worksheets("VP46").Cells.Clear
Worksheets("VR-61").Cells.Clear
Worksheets("CHUGACH").Cells.Clear
Worksheets("CIVILIAN-CONTRACTOR").Cells.Clear
Worksheets("FIRE DEPARTMENT").Cells.Clear
'turn on screen updating
Application.ScreenUpdating = True
'reenable events
Application.EnableEvents = True
'display warning message
MsgBox "Row " & rngCell.Row & " does not have a valid status" & _
vbCrLf & _
"It has this: " & rngCell.Offset(0, intStatusCol - 1).Text & _
vbCrLf & "The program will now quit - correct data and try again"
'quit sub
Exit Sub
End Select
Next rngCell
End If
'reenable events
Application.EnableEvents = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
'turn on screen updating
Application.ScreenUpdating = True
'reenable events
Application.EnableEvents = True
End Sub


Report •

Related Solutions


Ask Question