Free Microsoft Excel 2013 Quick Reference

Run macro after paste Results

Is there a way to run a macro after pasting information into a cell?

For example excel lets you run things when you open the workbook:

Private Sub Workbook_Open()
End Sub

Is there one for paste as well?

Hi all,
is it possibe to run a macro when cells have been coppied and then pasted in to a worksheet

can this be done in the sheet change event

i have some code in the change event but i only want it to run if someone pastes into that sheet

thank you
Helen

Hey,

I'm working on a project for work and I came across something I need help with

I don't have too much experience with VBA code

I'm looking to run a copy/paste macro AFTER a cell's value is changed. Is this possible?

Attached is a excel file showing what I'd like

Thank you soooo much for your time and efforts,
Bob

Hi the following macro works great if not run before. it updates depending on how many rows are filled in in column B

if I add more data in row B and run macro again it does not update new workbook.

can you please help


	VB:
	
 
Sub generate_new_workbook() 
     '
     ' generate_new_workbook Macro
     ' Macro recorded 09/06/2011 by scott forsyth
     '
  
     '
    Dim lr As Long, i As Long 
        Dim ws As Worksheet 
        Dim shname As String 
        Set ws = Sheets("Timesheets") 
        Application.ScreenUpdating = False 
  'Count first cell from Left
        lr = ws.Cells(Rows.Count, 2).End(xlUp).Row 
  
  'first cell number down
        For i = 4 To lr 
            If Cells(i, 2)  "" Then 
  'Count cell from left for Sheet Name
                    shname = Cells(i, 2).Value 
  
           Set wb1 = Workbooks.Open(Filename:="H:TimesheetsNew.xls") 
                Workbooks("New.xls").Activate 
                Sheets("One").Select 
  
  
                    If Not SheetExists(shname) Then 
  
                      Workbooks("Timesheet Creator.xls").Activate 
  
  'Pasted cell name
                            ws.Range("N4") = shname 
  
  
                    Workbooks("New.xls").Activate 
  
                            Sheets.Add After:=Sheets(Sheets.Count) 
                            ActiveSheet.Name = shname 
                            ws.Range("O3:AJ32").Copy 
                            Sheets(shname).Range("A1").PasteSpecial Paste:=xlPasteValues 
                            Sheets(shname).Range("A1").PasteSpecial Paste:=xlPasteFormats 
                            Sheets(shname).Range("A1").PasteSpecial Paste:=8 
  
                            Application.CutCopyMode = False 
                            ws.Activate 
  
  
                        wb1.Save 
                        wb1.Close False 
                    Set wb1 = Nothing 
  
  
                        End If 
                    End If 
                Next i 
                Application.ScreenUpdating = True 
  
        End Sub 
  
  
        Function SheetExists(Sheetname As String) As Boolean 
                On Error Resume Next 
                SheetExists = Len(Sheets(Sheetname).Name) 
                On Error Goto 0 
        End Function 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


I am trying to run a macro every 15 minutes after opening it. I did read something on here that helped me "http://www.ozgrid.com/Excel/run-macro-on-time.htm", but it only seemed to refresh at 15 minutes past the hour. Not at 00:30, 00:45, or 00:00. Any help would be greatly appreciated.

I have a macro that forces the user to enable macros or the spreadsheet cannot be accessed. Once macros are enabled it allows the user access to the spreadsheet. However, I would like for two additional macros to run back to back. These two macros need to be run automatically when the spreadsheet is accessed when the macros are enabled. The two macros disable the copy/cut/paste functions and disable the hide/unhide functions. Question is how do I write the macro to run the other two macros after access to the spreadsheet has been obtained. Macros are available for review. Any help would be appreciated.

is it possible to have a macro run after paste?
i know how to do it on cell value change(been there done that added a delay)
but want to run it even if same value pasted in cell

Hello guys! I'm trying to figure out how to make this work
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim mirango As Range
Dim intersecta As Range
Dim LR3 As Long
Dim aas As String

LR3 = Range("C6500").End(xlUp).Row
Set mirango = Range("C15" & ":" & "C" & LR3)
Set intersecta = intersect(Target, mirango)


If intersecta Is Nothing Then
Exit Sub
Else
aas = ActiveCell.Value

Call Module1.extraer(aas)

End If

End Sub
My code finds the last used cell within a range and if any of them is clicked, then a macro is called.

I want to obtain the value of the clicked cell (a single cell) and then call "extraer" with the value of the clicked cell as an argument

My macro "extraer" :

Sub extraer(a As String)

Dim c As String
Dim LR As Integer
Dim rango As Range



Sheets("EMBARQUES").Select
LR = Range("A6500").End(xlUp).Row

rango = Range("A2" & ":" & "A" & LR)

For Each cell In rango
If cell.Value = a Then
    c = cell.Row
    Range("B2" & ":" & "P" & c).Select
    Selection.Copy
    Sheets(1).Select
    
    Range("E15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
End If
Next cell


End Sub
This macro is intended to do something really simple, but somehow, I can't manage to work this out! Can anyone help me to see the error?

The error run time error 91: object cariable or With block variable not set
And the debug mode highlights rango = Range("A2" & ":" & "A" & LR)

help please?

Hi, how can i do in one macro paste special function but from 2 interfaces.
I want to paste special - value to excel sheet by button. I have this 2 types of macro, but i don know how can i get it together.

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
OR

    ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
        DisplayAsIcon:=False
i copy any value and i want after clicking on button paste special this value. But it can be from other excel sheet or from our system. Can i combinate this 2 rows or can i write it in one line with condition (if doesnt work first, use second?

now it works only if i have in macro only one possibility - the first or second. But if is there only the one line, copying from the other window gives me error. If i give both lines it gives me error too.
pls. can you help me?

ps: can i remember history after run macro? After all macros what i have i can not make undo, because it clear history of undo.

thx

In the attached workbook "Quote Sheets" I recorded a macro to copy information to workbook "Quote review". Only after finishing did it dawn on me that the 1st thing users will do is save "Quote sheets" to a new workbook name. Is there a way to have the macro reflect the new workbook name or is there a command like "previous workbook.
Thank you,
Sick
Here's the code:
Sub copytoquotereview()
'
' copytoquotereview Macro
'

'
    Workbooks.Open Filename:= _
        "C:UsersJDocumentsQuoteQuote Review.xlsm"
    Rows("5:5").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Windows("Quote Sheets.xlsm").Activate
       Range("C11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Quote Review.xlsm").Activate
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Windows("Quote Sheets.xlsm").Activate
    Range("C6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Quote Review.xlsm").Activate
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Windows("Quote Sheets.xlsm").Activate
    Range("C7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Quote Review.xlsm").Activate
    Range("F5").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Windows("Quote Sheets.xlsm").Activate
    Range("G15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Quote Review.xlsm").Activate
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Windows("Quote Sheets.xlsm").Activate
    ActiveWindow.SmallScroll Down:=21
    Range("G28").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Quote Review.xlsm").Activate
    Range("H5").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    ActiveWorkbook.Close
End Sub


Hi Guys,
I have AutoCad macro that pastes data(text) from AutoCAD table into a excel worsheet "Mechanical". its oastes the values cell by cell.

Then i have a Macro "Adjust Format" in Excel that formats the data in "Mechanical" sheet.

I want to run macro "Adjust Format" on " mechanical" sheet after Auto Cad Macro is done pasting the data in the excel sheet.

Any help will be highly appreciated.

thanks.

roop.

Basically I have This code running and would like after it has completed be able to have the user select any cell in column A that would runn the second snippit of code posted can this be done I have been trying for a while now and I am unable to get this to work...

Here Is the first Code:


	VB:
	
 IndividualFormLookup() 
     '
     'SET VARIABLES
     '
    Dim cn As New ADODB.Connection 
    Dim rs As ADODB.Recordset 
    Dim stDB As String, stSQL As String, stConn As String 
    Dim ws As Worksheet 
    Dim Search As String 
     
     
    Set ws = ThisWorkbook.Worksheets("Individual Form Lookup") 
    Search = ws.Range("C1").Value 
     '
     'NAME DATABASE
     '
    stDB = "C:UsersxxxxxxDesktopForms Tracking.accdb" 
    stConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & stDB & ";" 
     
    cn.ConnectionString = stConn 
    cn.Open 
     
    stSQL = "SELECT * " 
    stSQL = stSQL & " FROM [Form Tracking] " 
    stSQL = stSQL & " WHERE [Form #/Revision Code] Like '%" + Search + "%'" 
     
     
    Set rs = New ADODB.Recordset 
     
    rs.Open stSQL, cn 
     '
     ' Clear Form
     '
     '
     '
    Rows("3:5000").Select 
    Selection.ClearContents 
    Range("C1").Select 
     '
     '
     '
     'ERROR CONTROL
     '
    If rs.EOF Then 
        MsgBox ("There are NO CURRENT records for that Form #") 
If rs.EOF Then Goto Err_MyProc: 
    End If 
     
    ws.Range("A3").CopyFromRecordset rs 
     
Err_MyProc: 
     '
     '
     'CLOSE CONNECTIONS
     '
     '
     '
    rs.Close 
     '
    cn.Close 
     '
     '
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Here is the Snippit I would like to run when the user selects a Cell from Column A:


	VB:
	
 OnClick() 
    Range(CurrentSelection).Select 
    Selection.Copy 
    Sheets("Information Data Sheet").Select 
    Range("B1").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Any help would be greatly appreciated I just have a feeling it is something stupid that I have overlooked

Thanks in advance!!

Hi Guys,
I have a AutoCAD macro which extracts the data from autocad table and pastes it in a excel worksheet "mechanical". it extracts and pastes data cell by cell.

I also have macro" Adjust Format" in excel that formats the the data in "Mechanical" sheet.

I want " Adjust Format" macro to run automaticaly on the" Mechanical" sheet after the paste from Autocad is finished.

Any help will be highly appreciated.

Thanks.

roop

Okay I have a piece of code which works fine but as soon as I protect my selectively locked cells and run the code again it throws a debugger error.

This piece of code copies all the text on my active workbook ,creates a new workbook and pastes(speial paste values only) it onto the new workbook and saves it.

The code

	VB:
	
Workbooks("Billing.xlsm").Activate 
 
 
Dim wks As Worksheet 
Dim newWkbk As Workbook 
 
ActiveWorkbook.Worksheets.Copy 'to a new workbook
Set newWkbk = ActiveWorkbook 
 
For Each wks In newWkbk.Worksheets 
    With wks.UsedRange 
        .Copy 
        .PasteSpecial Paste:=xlPasteValues 
    End With 
Next wks 
 
Application.CutCopyMode = False 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
The error shows up on the paste special line of code.How can I make this code run even after protecting the Workbook?

is it possible to run a macro in another macro

i am trying to sum a column and input data into another work book after formating a table.

both codes on their own work perfectly well and both belong in the same workbook

i've have tried copying and pasting the summing macro into the end of the formatting macro, and everytime it comes up with an error,

how can i fire up my summing macro after the formating from the same button

Hi
I have a macro which tidies up before it does some copy/paste. I want the macro "TransDataBase"to run then call another macro "DeleteRowOnCell", then finish running the first macro (TransDatabase). At present it stops after running "DeleteRowOnCell"

Portion of "TransDatabase:
Columns("j:j").Replace What:="L", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False
Columns("j:j").Select
Application.Run "PERSONAL.XLS!DeleteRowOnCell"
Range("Data").Select
Range("LastData").Activate
Selection.Copy

Pretty clueless on VBA. Tks

Hi All,

I require some assistance. I have two macros that I would like to combine into one, or run the after one another on the same spreadsheet.

Below are the Macro's

	VB:
	
Macro 1 
 
Sub Macro1() 
     '
     '
     '
    Columns("L:L").Select 
    Selection.Delete Shift:=xlToLeft 
    Rows("1:1").Select 
    Selection.Copy 
    Sheets("Sheet3").Select 
    Rows("1:1").Select 
    ActiveSheet.Paste 
    Columns("H:H").EntireColumn.AutoFit 
    Columns("I:I").EntireColumn.AutoFit 
    Columns("K:K").EntireColumn.AutoFit 
    Columns("G:G").EntireColumn.AutoFit 
    Columns("A:A").EntireColumn.AutoFit 
    Columns("B:B").ColumnWidth = 26.71 
    Sheets("Text").Select 
    Sheets("Test").Name = "Info" 
    Sheets("Text").Select 
    Sheets("Text").Name = "Source" 
    Range("A1").Select 
    Application.CutCopyMode = False 
    ActiveCell.FormulaR1C1 = "Source" 
    Sheets("Sheet3").Select 
    Sheets("Sheet3").Name = "Results" 
    Range("H9").Select 
End Sub 
 
Macro2 
Private Sub Worksheet_Activate() 
    Dim rng As Range, x As Range, temp 
    Application.ScreenUpdating = False 
    Set rng = Sheets("info").Range("a1").CurrentRegion 
    With Sheets("Source").Range("a1") 
        temp = .Value 
        .Value = rng.Cells(1).Value 
        Set x = .CurrentRegion 
    End With 
    Cells.Clear 
    rng.AdvancedFilter xlFilterCopy, x, Cells(1) 
    Sheets("Source").Cells(1).Value = temp 
    Application.ScreenUpdating = True 
    Set rng = Nothing 
    Set x = Nothing 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Regards

I have a macro that will copy and paste certain columns, to a new sheet.
It works in some workbooks, but it will not keep the values once they have been pasted into a new sheet in workbooks with filter in place. Problem I am having is that I need to filter data I have and then copy and paste that data into a new sheet. Is there a way to keep the filter in and make this macro work or is there a code I can use to run the filter when running macro for a specific word than copy and paste rows/columns that include that specific word?

	VB:
	
 NewTab() 
    Dim sName As String 
     
    sName = Application.InputBox("Enter the new sheet name:", Title:="New Sheet Title", Type:=2) 
    If sName = "" Then Exit Sub 
     
    ActiveWorkbook.Sheets.Add After:=Sheets(Sheets.Count) 
    Sheets(Sheets.Count).Name = sName 
     
    Sheets("PriceSheets-ItemList").Range("A:A").Copy 
    With Sheets(sName).Range("A1") 
        .PasteSpecial xlValues 
        .PasteSpecial xlFormats 
        .PasteSpecial xlPasteValidation 
    End With 
     
    Sheets("PriceSheets-ItemList").Range("J:J").Copy 
    With Sheets(sName).Range("B1") 
        .PasteSpecial xlValues 
        .PasteSpecial xlFormats 
        .PasteSpecial xlPasteValidation 
    End With 
     
    Sheets("PriceSheets-ItemList").Range("O:P").Copy 
    With Sheets(sName).Range("C1") 
        .PasteSpecial xlValues 
        .PasteSpecial xlFormats 
        .PasteSpecial xlPasteValidation 
    End With 
    Sheets("PriceSheets-ItemList").Range("AC:BK").Copy 
    With Sheets(sName).Range("D1") 
        .PasteSpecial xlValues 
        .PasteSpecial xlFormats 
        .PasteSpecial xlPasteValidation 
    End With 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
I keep getting an error saying that pastespecial xlvalues for Range("D1") cannot be run for some reason.

Hi there,

Another noob to VBA, my apologies. I can modify existing code, but I am hopeless at create new ones. Please help me get started on what I hope is a rather simple bit of code.

My spreadsheet contains several rows each relating to a project. Cells concatenate information to create a link to reference an external spreadsheet. I would like to automate the "copy, paste special (values), F2, tab, move to adjacent cell" routine.

Once finished it should go something like this: the user will enter the next project ID in the yellow cells, links will be created with concatenated info, user will run macro to copy/paste formulas and information will then populate.

Thank you very much in advance,
Jamie.
File is attached with concatenated

Split off from http://www.ozgrid.com/forum/showthread.php?t=73351

Dave, or anyone who can help. Thanks for all of your help so far. Here is the program we have been working on. Everything is functional, however yesterday the macro began taking twenty to thirty minutes to run. Before that it was only taking about 5 minutes. All of the code commented out in the macros is code that we took out based on the suggestions found here to improve the time. If anyone could take a look at the macro and show us what else we can do to improve/explain what is causing the delay, that would be great. Thanks again.


	VB:
	
 Update_List() 
     '---------------Opening Summary Sheet to ALL clear data in all Tabs---------------------
    Application.ScreenUpdating = False 
    Windows("Summary Sheet 3.xls").Activate 
    Sheets("sort by early-late").Activate 
    Call ClearContents 
     '-----------------------Call EVERYHTING!!!!!!!!!!!!!!!!---------------------
     
    Call Everything 
     
     '---------------------------------NEVER CHANGE CODE BELOW THIS LINE----------------------------------------------
     '--------------Early / Late ----- To be Done Last after SUMMARY File - Sort by Early-Late Sheet FULL
    Windows("Summary Sheet 3.xls").Activate 
    Sheets("sort by early-late").Range("L7").Copy 'Select
     'Range("L7").Select
     'Application.CutCopyMode = False
     'Selection.Copy
     'Range("A11").Select
    TotalRows = Range("A11", Selection.End(xlDown)).Count 
     'TotalRows = Selection.Count
    For r = 1 To TotalRows 
        Range("J11").Offset(r - 1, 0).Paste 'Select
         'ActiveSheet.Paste
    Next r 
     
     
     '-----------% Complete -------------------
    Range("L5").Copy 'Select
     'Application.CutCopyMode = False
     'Selection.Copy
    For r = 1 To TotalRows 
        Range("I11").Offset(r - 1, 0).Paste 'Select
         'ActiveSheet.Paste
    Next r 
     '------------Format Cell Type
    Columns("I:I").NumberFormat = "0" 'Select
     'Selection.NumberFormat = "0"
    Columns("K:K").NumberFormat = "0" 'Select
     'Selection.NumberFormat = "0"
    Columns("N:N").NumberFormat = "[$-409]d-mmm;@" 
     
     '--------------Font/Size Formatting Before Copy-------------------
     'Range("A11").Select
    Range("A11", Selection.End(xlDown)).Select 
    With Selection 
        .HorizontalAlignment = xlCenter 
        .VerticalAlignment = xlBottom 
        .WrapText = False 
        .Orientation = 0 
        .AddIndent = False 
        .IndentLevel = 0 
        .ShrinkToFit = False 
        .ReadingOrder = xlContext 
        .MergeCells = False 
    End With 
    With Selection.Font 
        .Name = "Arial" 
        .Size = 10 
        .Strikethrough = False 
        .Superscript = False 
        .Subscript = False 
        .OutlineFont = False 
        .Shadow = False 
        .Underline = xlUnderlineStyleNone 
        .ColorIndex = xlAutomatic 
    End With 
    Selection.Font.Bold = False 
     '--------------Font/Size for B and C
     'Range("B11:C11").Select
    Range("B11:C11", Selection.End(xlDown)).Select 
    With Selection 
        .HorizontalAlignment = xlLeft 
        .VerticalAlignment = xlBottom 
        .WrapText = False 
        .Orientation = 0 
        .AddIndent = False 
        .IndentLevel = 0 
        .ShrinkToFit = False 
        .ReadingOrder = xlContext 
        .MergeCells = False 
    End With 
    With Selection.Font 
        .Name = "Arial" 
        .Size = 12 
        .Strikethrough = False 
        .Superscript = False 
        .Subscript = False 
        .OutlineFont = False 
        .Shadow = False 
        .Underline = xlUnderlineStyleNone 
        .ColorIndex = xlAutomatic 
    End With 
    Selection.Font.Bold = True 
    Selection.NumberFormat = "General" 
     '------------------Font/Size for D to I
     'Range("D11:I11").Select
    Range("D11:I11", Selection.End(xlDown)).Select 
    With Selection 
        .HorizontalAlignment = xlCenter 
        .VerticalAlignment = xlBottom 
        .WrapText = False 
        .Orientation = 0 
        .AddIndent = False 
        .IndentLevel = 0 
        .ShrinkToFit = False 
        .ReadingOrder = xlContext 
        .MergeCells = False 
    End With 
    With Selection.Font 
        .Name = "Arial" 
        .Size = 10 
        .Strikethrough = False 
        .Superscript = False 
        .Subscript = False 
        .OutlineFont = False 
        .Shadow = False 
        .Underline = xlUnderlineStyleNone 
        .ColorIndex = xlAutomatic 
    End With 
    Selection.Font.Bold = False 
     '------------------Font/Size for J
     'Range("J11").Select
    Range("J11", Selection.End(xlDown)).Select 
    With Selection 
        .HorizontalAlignment = xlCenter 
        .VerticalAlignment = xlBottom 
        .WrapText = False 
        .Orientation = 0 
        .AddIndent = False 
        .IndentLevel = 0 
        .ShrinkToFit = False 
        .ReadingOrder = xlContext 
        .MergeCells = False 
    End With 
    With Selection.Font 
        .Name = "Arial" 
        .Size = 11 
        .Strikethrough = False 
        .Superscript = False 
        .Subscript = False 
        .OutlineFont = False 
        .Shadow = False 
        .Underline = xlUnderlineStyleNone 
        .ColorIndex = xlAutomatic 
    End With 
    Selection.Font.Bold = False 
     '------------------Font/Size for K to L
     'Range("K11:L11").Select
    Range("K11:L11", Selection.End(xlDown)).Select 
    With Selection 
        .HorizontalAlignment = xlCenter 
        .VerticalAlignment = xlBottom 
        .WrapText = False 
        .Orientation = 0 
        .AddIndent = False 
        .IndentLevel = 0 
        .ShrinkToFit = False 
        .ReadingOrder = xlContext 
        .MergeCells = False 
    End With 
    With Selection.Font 
        .Name = "Arial" 
        .Size = 10 
        .Strikethrough = False 
        .Superscript = False 
        .Subscript = False 
        .OutlineFont = False 
        .Shadow = False 
        .Underline = xlUnderlineStyleNone 
        .ColorIndex = xlAutomatic 
    End With 
    Selection.Font.Bold = False 
     
     
     '-----Condition Format in Sort by early-late
     'Sheets("sort by early-late").Select
     'Range("J11").Select
    Sheets("sort by early-late").Range("J11", Selection.End(xlDown)).Select 
    Selection.FormatConditions.Delete 
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _ 
    Formula1:="0" 
    With Selection.FormatConditions(1).Font 
        .Bold = True 
        .Italic = False 
        .ColorIndex = 2 
    End With 
    Selection.FormatConditions(1).Interior.ColorIndex = 3 
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _ 
    Formula1:="0", Formula2:="10" 
    Selection.FormatConditions(2).Interior.ColorIndex = 6 
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _ 
    Formula1:="10" 
    Selection.FormatConditions(3).Interior.ColorIndex = 4 
     
     '---------Sort by Early/Late-----------------------
     'Range("A10:M10").Select
    Range("A10:N10", Selection.End(xlDown)).Select 
    Range("A10:N10", Selection.End(xlDown)).Sort Key1:=Range("J11"), _ 
    Order1:=xlAscending, Header:=xlYes, _ 
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 
     'Range("A11").Select
     '---------Sort by SAP early-late--------------------
     'Range("A10:M10").Select
    Range("A10:N10", Selection.End(xlDown)).Copy 'Select
     'Application.CutCopyMode = False
     'Selection.Copy
     
    Sheets("sort by SAP early-late").Range("A10").Paste 'Select
     'Range("A10").Select
     'ActiveSheet.Paste
    Application.CutCopyMode = False 
     
    total = Range("A1", Range("A65536").End(xlUp)).Count 'Select
     'total = Selection.Count
     
     'Range("J11").Select
    Do 
        For r = 11 To total 
            If Cells(r, 10).Value > -1 Then 
                Cells(r - 1, 10).Select 
                yellowstart = Selection.Row 
                YellowRange = "A" & yellowstart 
                n = 1 
                Exit Do 
            End If 
        Next r 
    Loop Until n = 1 
    n = 0 
    Do 
        For r = yellowstart To total 
            If Cells(r, 10).Value > 10 Then 
                Cells(r, 10).Select 
                greenstart = Selection.Row 
                GreenRange = "A" & greenstart 
                n = 1 
                Exit Do 
            End If 
        Next r 
    Loop Until n = 1 
     
     'Range(YellowRange).Select
    Range(YellowRange, "N" & yellowstart).Select 
    Range(Selection, Selection.End(xlUp)).Select 
    Selection.Sort Key1:=Range("G11"), Order1:=xlAscending, Header:=xlYes, _ 
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 
     
     'Range(GreenRange).Select
    Range(GreenRange, "N" & greenstart).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Sort Key1:=Range("G11"), Order1:=xlAscending, Header:=xlNo, _ 
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 
     
    YellowEnd = "A" & greenstart - 1 
    Range(YellowRange, YellowEnd).Select 
    Range(Selection, "N" & greenstart - 1).Select 
    Selection.Sort Key1:=Range("G11"), Order1:=xlAscending, Header:=xlYes, _ 
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 
     
    Range("A11").Select 
     '----------------------------------------------
     
     '------- Due Next 2 Weeks, Past Due, Due Today, and Dept. Tabs ------------
    D2W = 0 
    PD = 0 
    DT = 0 
    GEN = 0 
    CP = 0 
    POL = 0 
    MET = 0 
    QC = 0 
    Coat = 0 
     
    Sheets("sort by SAP early-late").Select 
    For r = 11 To total 
        On Error Goto myFix 
        If Cells(r, 7).Value - Cells(1, 2).Value > -1 And Cells(r, 7).Value - Cells(1, 2).Value < 15 Then 
            Workbooks("Summary Sheet 3.xls").Worksheets("Due Next 2 Weeks").Range("A11:N11").Offset(D2W, 0).Value =
Workbooks("Summary Sheet 3.xls").Worksheets("sort by SAP early-late").Range("A" & r, "M" & r).Value 
            D2W = D2W + 1 
myFix: 
            Resume Next 
        End If 
         
        If Cells(r, 13).Value = "Past Due" Then 
            Workbooks("Summary Sheet 3.xls").Worksheets("Past Due").Range("A11:N11").Offset(PD, 0).Value = Workbooks("Summary
Sheet 3.xls").Worksheets("sort by SAP early-late").Range("A" & r, "M" & r).Value 
            PD = PD + 1 
        ElseIf Cells(r, 13).Value = "Due Today" Then 
            Workbooks("Summary Sheet 3.xls").Worksheets("Due Today").Range("A11:N11").Offset(DT, 0).Value =
Workbooks("Summary Sheet 3.xls").Worksheets("sort by SAP early-late").Range("A" & r, "M" & r).Value 
            DT = DT + 1 
        End If 
         
        If Cells(r, 8).Text = "Generate" Then 
            Workbooks("Summary Sheet 3.xls").Worksheets("Generate").Range("A11:N11").Offset(GEN, 0).Value =
Workbooks("Summary Sheet 3.xls").Worksheets("sort by SAP early-late").Range("A" & r, "M" & r).Value 
            GEN = GEN + 1 
        ElseIf Cells(r, 8).Text = "CP" Then 
            Workbooks("Summary Sheet 3.xls").Worksheets("CP").Range("A11:N11").Offset(CP, 0).Value = Workbooks("Summary Sheet
3.xls").Worksheets("sort by SAP early-late").Range("A" & r, "M" & r).Value 
            CP = CP + 1 
        ElseIf Cells(r, 8).Text = "Polish" Or Cells(r, 8).Text = "HSP" Or Cells(r, 8).Text = "DPT" Or Cells(r, 8).Text =
"Spindle" Or Cells(r, 8).Text = "SP" Or Cells(r, 8).Text = "Adv Polish" Then 
            Workbooks("Summary Sheet 3.xls").Worksheets("Spin.-Adv. Pol.").Range("A11:N11").Offset(POL, 0).Value =
Workbooks("Summary Sheet 3.xls").Worksheets("sort by SAP early-late").Range("A" & r, "M" & r).Value 
            POL = POL + 1 
        ElseIf Cells(r, 8).Text = "Metro" Or Cells(r, 8).Text = "MRF" Or Cells(r, 8).Text = "Metro/MRF" Or Cells(r, 8).Text =
"Metro/QC" Then 
            Workbooks("Summary Sheet 3.xls").Worksheets("Metro-MRF").Range("A11:N11").Offset(MET, 0).Value =
Workbooks("Summary Sheet 3.xls").Worksheets("sort by SAP early-late").Range("A" & r, "M" & r).Value 
            MET = MET + 1 
        ElseIf Cells(r, 8).Text = "QC" Then 
            Workbooks("Summary Sheet 3.xls").Worksheets("QC").Range("A11:N11").Offset(QC, 0).Value = Workbooks("Summary Sheet
3.xls").Worksheets("sort by SAP early-late").Range("A" & r, "M" & r).Value 
            QC = QC + 1 
        ElseIf Cells(r, 8).Text = "Coat" Then 
            Workbooks("Summary Sheet 3.xls").Worksheets("Coat").Range("A11:N11").Offset(Coat, 0).Value = Workbooks("Summary
Sheet 3.xls").Worksheets("sort by SAP early-late").Range("A" & r, "M" & r).Value 
            Coat = Coat + 1 
        End If 
    Next r 
     
     '------------------------Sort Past Due/Due Today by Dept.--------------
     'Sheets("Past Due").Select
     'Range("A10:M10").Select
     'Range("A10:N10", Selection.End(xlDown)).Select
    Sheets("Past Due").Range("A10:M10").Sort Key1:=Range("H11"), Order1:=xlAscending, _ 
    Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 
     
     'Sheets("Due Today").Select
     'Range("A10:M10").Select
     'Range("A10:N10", Selection.End(xlDown)).Select
    Sheets("Due Today").Range("A10:N10", Selection.End(xlDown)).Sort Key1:=Range("H11"), _ 
    Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ 
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal 
     
     'Sheets("Due Next 2 Weeks").Select
     'Range("A10:M10").Select
     'Range("A10:N10", Selection.End(xlDown)).Select
    Sheets("Due Next 2 Weeks").Range("A10:N10", Selection.End(xlDown)).Sort _ 
    Key1:=Range("H11"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _ 
    MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal 
     
    Sheets("sort by early-late").Select 
    Range("A11").Select 
     
    a = 0 
    Application.ScreenUpdating = True 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
This is the code for sub Everything


	VB:
	
 Everything() 
     
    Dim bookName As Variant 
    Dim xSheet As Worksheet 
    Dim Sheet2 As Worksheet 
     
    For Each bookName In Array("Beam Shaping Module_N.xls", "Athena_N.xls", "ATRS_M.xls", "Energy Sensor XT1400_B.xls",
"Energy Sensor XT1700_N.xls", "Illumination XT1400_N.xls", "Level Sensor XT1400_B.xls", "Level Sensor XTIII 1900_M.xls",
"Molecular Imprint_N.xls", "SMASH_B.xls", "SVGH_M.xls", "Kappa_B.xls", "Projects.xls", "OML.xls") 
         
        Workbooks.Open bookName, ReadOnly:=True, UpdateLinks:=0 
         
        For Each xSheet In Workbooks(bookName).Worksheets 
             'Windows(bookName).Activate
            xSheet.Activate 
            Select Case xSheet.Tab.ColorIndex 
            Case 4 
                Goto myFileDone 
            Case Else 
                 
                 '-------------------------------------------------------------------------------------------------------
                Columns("A:L").EntireColumn.Hidden = False 'Select
                 'Selection.EntireColumn.Hidden = False
                 '-------------- Define Start/Stop of Cycle Time Range-----------------------
                Start = 0 
                last = 0 
                Do 
                    For c = 1 To 75 
                        If Cells(8, c).Interior.ColorIndex = 4 Then 
                            Start = c 
                        End If 
                        If Cells(8, c).Interior.ColorIndex = 3 Then 
                            last = c 
                            i = 1 
                            Exit Do 
                        End If 
                    Next c 
                Loop Until i = 1 
                 '-------Copy all data ---------------------
                 'Range("A10:Z10").Select
                 'Range(Selection, Selection.End(xlDown)).Select
                 'Selection.SpecialCells(xlCellTypeVisible).Select
                 'Application.CutCopyMode = False
                 'Selection.Copy
                Range("A10:Z10", Selection.End(xlDown)).SpecialCells(xlCellTypeVisible).Copy 
                Windows("Summary Sheet 3.xls").Activate 
                 '--------Paste in Temp Sheet2------------
                 'Sheets("Sheet2").Select
                Sheets("Sheet2").Range("A1").Select 
                ActiveSheet.Paste 
                 'Range("A1").Select
                 'Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                xlNone, SkipBlanks:=False, Transpose:=False 
                Sheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ 
                xlNone, SkipBlanks:=False, Transpose:=False 
                 ' -----------Delete Top Row-----------------
                 'Rows("1:1").Select
                 'Application.CutCopyMode = False
                 'Selection.Delete Shift:=xlUp
                Rows("1:1").Delete Shift:=xlUp 
                 '-------------------------
                NumRows = Range("A1", Range("A65536").End(xlUp)).Count 
                 '---------Cut and Paste in Main Sheet1--------
                If Range("A1")  "" Then 
                    If Range("A2")  "" Then 
                         'Range("A1:D1").Select
                        Range("A1:D1", Selection.End(xlDown)).Cut 'Select
                         'NumRows = Selection.Count
                         'Selection.Cut
                    ElseIf Range("A2") = "" Then 
                        Range("A1:D1").Cut 'Select
                         'NumRows = 1
                         'Selection.Cut
                    End If 
                End If 
                If Range("A1") = "" Then 
                    Range("A1").Cut 'Select
                     'Selection.Cut
                End If 
                 '---------Calculate Which line to paste on---------
                Sheets("sort by early-late").Select 
                If Sheets("sort by early-late").Range("D11") = "" Then 
                    total = 0 
                    Cells(11, 4).Select 
                    ActiveSheet.Paste 
                Else 
                    total = Sheets("sort by early-late").Range("D11", Range("D65536").End(xlUp)).Count 
                    Cells(total + 11, 4).Select 
                    ActiveSheet.Paste 
                End If 
                 
                 
                 '------------Remaining Cycle Time and Location----------------
                 'Sheets("Sheet2").Select
                n = 0 
                 
                For r = 1 To NumRows 
                    For c = Start To last 
                        If Sheets("Sheet2").Cells(r, c).Interior.ColorIndex = 6 Then 
                            Workbooks("Summary Sheet 3.xls").Worksheets("sort by early-late").Range("K11").Offset(total + n,
0).Value = xSheet.Cells(6, c).Value 
                            Workbooks("Summary Sheet 3.xls").Worksheets("sort by early-late").Range("H11").Offset(total + n,
0).Value = xSheet.Cells(8, c).Value 
                            If Sheets("Sheet2").Cells(r, c) < Workbooks("Summary Sheet 3.xls").Worksheets("sort by
early-late").Range("B1").Value Then 
                                Workbooks("Summary Sheet 3.xls").Worksheets("sort by early-late").Range("M11").Offset(total +
n, 0).Value = "Past Due" 
                                Workbooks("Summary Sheet 3.xls").Worksheets("sort by early-late").Range("N11").Offset(total +
n, 0).Value = Workbooks("Summary Sheet 3.xls").Worksheets("Sheet2").Cells(r, c).Value 
                            ElseIf Sheets("Sheet2").Cells(r, c) = Workbooks("Summary Sheet 3.xls").Worksheets("sort by
early-late").Range("B1").Value Then 
                                Workbooks("Summary Sheet 3.xls").Worksheets("sort by early-late").Range("M11").Offset(total +
n, 0).Value = "Due Today" 
                            End If 
                        ElseIf Sheets("Sheet2").Cells(r, c).Interior.ColorIndex = 46 Then 
                            Workbooks("Summary Sheet 3.xls").Worksheets("sort by early-late").Range("K11").Offset(total + n,
0).Value = xSheet.Cells(6, c).Value 
                            Workbooks("Summary Sheet 3.xls").Worksheets("sort by early-late").Range("H11").Offset(total + n,
0).Value = "MRB" 
                        ElseIf Sheets("Sheet2").Cells(r, c).Interior.ColorIndex = 3 Then 
                            Workbooks("Summary Sheet 3.xls").Worksheets("sort by early-late").Range("K11").Offset(total + n,
0).Value = xSheet.Cells(6, c).Value 
                            Workbooks("Summary Sheet 3.xls").Worksheets("sort by early-late").Range("H11").Offset(total + n,
0).Value = "Scrap" 
                        End If 
                    Next c 
                    n = n + 1 
                Next r 
                 '---------------Pasting Values for Other Cells -----------
                 
                n = 0 
                For i = 1 To NumRows 
                    Workbooks("Summary Sheet 3.xls").Worksheets("sort by early-late").Range("A11").Offset(total + n, 0).Value
= xSheet.Cells(2, 1).Value 
                    Workbooks("Summary Sheet 3.xls").Worksheets("sort by early-late").Range("B11").Offset(total + n, 0).Value
= xSheet.Cells(3, 7).Value 
                    Workbooks("Summary Sheet 3.xls").Worksheets("sort by early-late").Range("C11").Offset(total + n, 0).Value
= xSheet.Cells(3, 1).Value 
                    Workbooks("Summary Sheet 3.xls").Worksheets("sort by early-late").Range("L11").Offset(total + n, 0).Value
= xSheet.Cells(5, 9).Value 
                    n = n + 1 
                Next i 
                 
                Call ClearSheet2 
myFileDone: 
                 
            End Select 
        Next xSheet 
         
         '----------When Done with ALL tabs ----->Close File, Before Opening New File
         
         'Selection.Copy
        Application.CutCopyMode = False 
         'Range("A1").Select
        Windows(bookName).Activate 
        ActiveWindow.Close SaveChanges:=False 
         
    Next bookName 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Just for reference purposes, the macros are used to retrieve data from master data sheets and compile them into a "summary sheet".


No luck finding an answer? You could always try Google.