Excel - A macro to sort multiple sheets

August 2017



Issue



I have 11 sheets in excel. 10 sheets need to pull information from sheet1.

This is for chefs at a catering service.

I have a key word in column A to differentiate each line of information.
What I need is...
  • Sheet 2 & 3 to pull the complete line from sheet1 if the word in column A is "Hot".
  • Sheet 4 & 5 to pull the complete line from sheet 1 if the word in column A is "Cold".
  • Sheet 6 to pull the complete line from sheet 1 if the word in column A is "Bulk".
  • Sheet 8 & 9 to pull the complete line from sheet 1 if the word in column A is "Pastry".
  • Sheet 10 to pull the complete line from sheet 1 if the word in column A is "Pres".

The other sheets are already covered.

I created a macro to sort the sheets based on three columns. It would be nice if this macro automatically ran everytime information was added to the sheet. Not to a certain line but to any area of the sheet to keep the information in order.

Solution


Try this macro:

Option Explicit  
Private Sub Worksheet_Change(ByVal Target As Range)  
Dim nxtRow As Integer  
'Determine if change was to Column H (8)  
 If Target.Column = 8 Then  
'If Yes, Determine if cell = Hot  
  If Target.Value = "H" Then  
'If Yes, find next empty row in Sheet 2  
   nxtRow = Sheets(2).Range("G" & Rows.Count).End(xlUp).Row + 1  
'Copy changed row and paste into Sheet 2  
    Target.EntireRow.Copy _  
     Destination:=Sheets(2).Range("A" & nxtRow)  
'If Yes, find next empty row in Sheet 3  
   nxtRow = Sheets(3).Range("G" & Rows.Count).End(xlUp).Row + 1  
'Copy changed row and paste into Sheet 3  
    Target.EntireRow.Copy _  
     Destination:=Sheets(3).Range("A" & nxtRow)  
 End If  
 End If  

'Determine if change was to Column H (8)  
 If Target.Column = 8 Then  
'If Yes, Determine if cell = Cold  
  If Target.Value = "C" Then  
'If Yes, find next empty row in Sheet 4  
   nxtRow = Sheets(4).Range("G" & Rows.Count).End(xlUp).Row + 1  
'Copy changed row and paste into Sheet 4  
    Target.EntireRow.Copy _  
     Destination:=Sheets(4).Range("A" & nxtRow)  
'If Yes, find next empty row in Sheet 5  
   nxtRow = Sheets(5).Range("G" & Rows.Count).End(xlUp).Row + 1  
'Copy changed row and paste into Sheet 3  
    Target.EntireRow.Copy _  
     Destination:=Sheets(5).Range("A" & nxtRow)  
 End If  
 End If  
   
 'Determine if change was to Column H (8)  
 If Target.Column = 8 Then  
'If Yes, Determine if cell = Presentation  
  If Target.Value = "P" Then  
'If Yes, find next empty row in Sheet 8  
   nxtRow = Sheets(8).Range("G" & Rows.Count).End(xlUp).Row + 1  
'Copy changed row and paste into Sheet 8  
    Target.EntireRow.Copy _  
     Destination:=Sheets(8).Range("A" & nxtRow)  
 End If  
 End If  
   
'Determine if change was to Column H (8)  
 If Target.Column = 8 Then  
'If Yes, Determine if cell = Pastry  
  If Target.Value = "PY" Then  
'If Yes, find next empty row in Sheet 10  
   nxtRow = Sheets(10).Range("G" & Rows.Count).End(xlUp).Row + 1  
'Copy changed row and paste into Sheet 10  
    Target.EntireRow.Copy _  
     Destination:=Sheets(10).Range("A" & nxtRow)  
'If Yes, find next empty row in Sheet 12  
   nxtRow = Sheets(11).Range("G" & Rows.Count).End(xlUp).Row + 1  
'Copy changed row and paste into Sheet 12  
    Target.EntireRow.Copy _  
     Destination:=Sheets(11).Range("A" & nxtRow)  
 End If  
 End If  
   
'Determine if change was to Column H (8)  
 If Target.Column = 8 Then  
'If Yes, Determine if cell = Bulk  
  If Target.Value = "B" Then  
'If Yes, find next empty row in Sheet 6  
   nxtRow = Sheets(6).Range("G" & Rows.Count).End(xlUp).Row + 1  
'Copy changed row and paste into Sheet 6  
    Target.EntireRow.Copy _  
     Destination:=Sheets(6).Range("A" & nxtRow)  
 End If  
 End If  

   
End Sub



Thanks to Jlee1978 for this tip.

Related


Published by aakai1056. Latest update on July 30, 2012 at 08:35 AM by aakai1056.
This document, titled "Excel - A macro to sort multiple sheets," is available under the Creative Commons license. Any copy, reuse, or modification of the content should be sufficiently credited to CCM (ccm.net).