I need help writing code that sorts a worksheet containing data for employees in the form of dates, and copies to multiple sheets based on the value in column "C". Employees work different units; each unit has one sheet for it's specific data.
Problem - I have been able to get the data copied accurately, but unable to paste if the row size on both sheets is inaccurate. In addition, I have created a row just under the data that contains statistical information, that I do not want to have "pasted over" when rows are inserted. Data is pasted from another database to the sheet "All Nursing Staff" when updated. I would like to be able to assign a macro to a command button to copy and paste the data to individual sheets for each unit when updated.
My Code:
Public Sub CopyData()
Dim All67 As Range
Dim rng As Range
Dim lStartRow As String
Dim lLastRow As String
Worksheets("67").Select
ActiveSheet.Unprotect Password:="lock"
Application.ScreenUpdating = False
Selection.EntireColumn.Hidden = False
Range("All67").Select
Selection.ClearContents
Selection.FormatConditions.Delete
Range("B:B,D:D,J:J").EntireColumn.Hidden = True
Worksheets("All Nursing Staff").Select
ActiveSheet.Unprotect Password:="lock"
Selection.EntireColumn.Hidden = False
lStartRow = Range("FirstAll").row
lLastRow = Range("LastAll").row - 1
ActiveSheet.Rows(lStartRow & ":" & lLastRow).Select
Selection.AutoFilter Field:=3, Criteria1:="67" _
& Minlimit, Operator:=xlAnd
Selection.Copy
Range("A434,A435,A436").EntireRow.Hidden = True
Range("B:B,D:D,J:J").EntireColumn.Hidden = True
Sheets("All Nursing Staff").AutoFilterMode = False
Worksheets("67").Select
Selection.EntireColumn.Hidden = False
lStartRow = Range("First67").row
lLastRow = Range("Last67").row - 1
ActiveSheet.Rows(lStartRow & ":" & lLastRow).Select
Range("A6").Select
ActiveSheet.Paste
Range("B:B,D:D,J:J").EntireColumn.Hidden = True
Selection.Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
lastRow = ActiveSheet.UsedRange.Rows.Count
'For r = LastRow To 1 Step -1
'If Application.WorksheetFunction.CountA(Rows(r)) = 0 _
'Then Rows(r).Delete
'Next r
Range("A6").Select
Worksheets("All Nursing Staff").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Bookmarks