Excel - A macro to sort multiple sheets

December 2016



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 :

This document entitled « Excel - A macro to sort multiple sheets » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.