Welcome, guest! Login / Register - Why register?
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

Your Name: Code Language: