Hi Simi,
Please, I need to copy from "Tudo" to "Nomes com Regras" it be like that:
A B C D E F G
1 aaa Regra1 Regra6
2
3
4 bbb
5
6
7 ccc
Columuns are merged in 3
Lines are mereged in 3
I built these codes:
' sort Rules in sheet 3
RowNum = Worksheets(3).UsedRange.Rows.Count
For R = 5 To RowNum + 1
Worksheets(3).Range("B" & R & ":LZ" & R).Sort Key1:=Worksheets(3).Range("A" & R), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight
Next R
I made this code, but it is very slow
'copy skiping lines between employees names from sheet 3 to sheet 4
Worksheets(3).Activate
lrow = Cells(Rows.Count, 1).End(xlUp).Row
j = 5
Range("A5").Select
For i = 5 To lrow
ActiveSheet.Cells(i, 1).Copy
Worksheets(4).Cells(j, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
j = j + 3
Next i
' Copy skiping columns for Regras from sheet 3 to 4
Worksheets(3).Activate
'lrow = Worksheets(4).UsedRange.Rows.Count
lrow = Worksheets(4).Cells(Rows.Count, 1).End(xlUp).Row
m = 2
j = 5
For i = 5 To lrow
lcol = Worksheets(3).Cells(i, Columns.Count).End(xlToLeft).Column
For k = 2 To lcol
ActiveSheet.Cells(i, k).Copy
Worksheets(4).Cells(j, m).PasteSpecial Paste:=xlValues
Worksheets(4).Cells(j, m).HorizontalAlignment = xlCenter
Worksheets(4).Cells(j, m).VerticalAlignment = xlCenter
Application.CutCopyMode = False
m = m + 3
Next k
m = 2
j = j + 3
Next i
'do the merges of employees names in sheet 4
Worksheets(4).Activate
j = 5
lrow = Worksheets(4).Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To lrow Step 3
Range(Cells(i, 1), Cells(i + 2, 1)).Select
Selection.Merge
Range(Cells(i, 1), Cells(i + 2, 1)).HorizontalAlignment = xlCenter
Range(Cells(i, 1), Cells(i + 2, 1)).VerticalAlignment = xlCenter
Next i
'do the merges of Rules in sheet 4
m = 4
j = 5
lrow = Worksheets(4).Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To lrow Step 3
lcol = Worksheets(4).Cells(i, Columns.Count).End(xlToLeft).Column
For k = 2 To lcol Step 3
Range(Cells(j, k), Cells(j, m)).Select
Selection.Merge
Range(Cells(i, k), Cells(i, m)).HorizontalAlignment = xlCenter
Range(Cells(i, k), Cells(i, m)).VerticalAlignment = xlCenter
m = m + 3
Next k
m = 4
j = j + 3
Next i
It works, but it is so slow. I have 75 employees and 100 rules. It is possible to optimize this code.