Forum Discussion

kevin.mcveigh's avatar
kevin.mcveigh
Copper Contributor
Jan 05, 2018

Macro changes revert when I save file

Hi I've got a macro that copies certain rows from a master sheet to specific individual sheets so that a huge sheet of 900 rows and 80 columns auto filters into teams.

It works perfectly when I run it with each sheet having the rows they need and nothing else.  Then I save it and it reverts to filling the top 20 rows on each sheet with the same top 20 rows from the master sheet.

 

Note on sheets where the correct list is over 20 rows deep the correct rows are copied in row 21 onwards.  

 

What am I missing to get it to save as I need?

 

Sub ALIS()

Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet

' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Full List")
Set Target = ActiveWorkbook.Worksheets("ALIS West")

j = 5 ' Start copying to row 5 in target sheet
For Each c In Source.Range("E1:E1000") ' Do 1000 rows
If c = "262 10555 ALIS West" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Full List")
Set Target = ActiveWorkbook.Worksheets("ALIS East")

j = 5 ' Start copying to row 5 in target sheet
For Each c In Source.Range("E1:E1000") ' Do 1000 rows
If c = "262 84555 ALIS East" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c

' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Full List")
Set Target = ActiveWorkbook.Worksheets("ALIS Furness")

j = 5 ' Start copying to row 5 in target sheet
For Each c In Source.Range("E1:E1000") ' Do 1000 rows
If c = "262 30350 ALIS Furness" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c

' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Full List")
Set Target = ActiveWorkbook.Worksheets("ALIS South Lakes")

j = 5 ' Start copying to row 5 in target sheet
For Each c In Source.Range("E1:E1000") ' Do 1000 rows
If c = "262 30351 ALIS South Lakes" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c


' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Full List")
Set Target = ActiveWorkbook.Worksheets("ALIS Liaison")

j = 5 ' Start copying to row 5 in target sheet
For Each c In Source.Range("E1:E1000") ' Do 1000 rows
If c = "262 20670 ALIS Liaison" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c

 

' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Full List")
Set Target = ActiveWorkbook.Worksheets("Crisis Assessment Centre")

j = 5 ' Start copying to row 5 in target sheet
For Each c In Source.Range("E1:E1000") ' Do 1000 rows
If c = "262 84556 Crisis Assessment Centre" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
End Sub

 

 

 

No RepliesBe the first to reply

Resources