Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)
Paste
Pasted by Ben ( 14 years ago )
Sub information()
'
' Macro1 Macro
'
'SPEED UP THE MACRO BY TURNING OFF THE FUNCTION THAT SHOWS THE ACTIONS ON SCREEN
'WHILE THEY ARE OCCURING
Application.ScreenUpdating = False
'****
'COPY FIRST COLUMN OF DATA
'COPY DATA FROM CREWS SHEETS
Sheets("Crews").Select
Range("D86:K456").Select
Selection.Copy
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Information"
Sheets("Information").Select
'FIND THE LAST CELL IN COLUMN A
ActiveCell.SpecialCells(xlLastCell).Select
lastrow1 = ActiveCell.Row
'PAST DATA
count1 = lastrow1
Cells(count1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'****
'COPY SECOND COLUMN OF DATA
'COPY DATA FROM CREWS SHEETS
Sheets("Crews").Select
Range("N86:U456").Select
Selection.Copy
Sheets("Information").Select
'FIND THE LAST CELL IN COLUMN A
ActiveCell.SpecialCells(xlLastCell).Select
lastrow2 = ActiveCell.Row
'PAST DATA
count2 = lastrow2 + 1
Cells(count2, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'****
'REMOVE EXCESS COLUMNS
Range("B:B,C:C,F:F,H:H").Select
Range("H1").Activate
Selection.Delete shift:=xlToLeft
'****
'REMOVE ROWS THAT ARE BLANK OR CONTAIN "NAME"
countend3 = Application.WorksheetFunction.CountA(Worksheets("Information").Range("A:A"))
count3 = 1
Do Until count3 = countend3 + 1
Cells(count3, 1).Select
If ActiveCell = "" Then
ActiveCell.EntireRow.Delete shift:=xlUp
ElseIf ActiveCell = "Name" Then
ActiveCell.EntireRow.Delete shift:=xlUp
countend3 = countend3 - 1
Else
count3 = count3 + 1
End If
Loop
'****
'SORT BASED ON COLUMN A
Columns("A:D").Select
Range("A287").Activate
ActiveWorkbook.Worksheets("Information").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Information").Sort.SortFields.Add Key:=Range( _
"A287"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Information").Sort
.SetRange Range("A1:D742")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'SPEED UP THE MACRO BY TURNING OFF THE FUNCTION THAT SHOWS THE ACTIONS ON SCREEN
'WHILE THEY ARE OCCURING
Application.ScreenUpdating = True
End Sub
Revise this Paste