 0
Thanks

A few words of thanks would be greatly appreciated.

# Excel - A macro to sort multiple sheets

## 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.
0
Thanks

A few words of thanks would be greatly appreciated.