Sub pd()Dim i As IntegerFor i = 26 To 2 Step -1 If Range(e & i) = Then Range(f & i) = Else Range(f & i) = End If If Range(b & i) = Then Range(c & i) = LG ElseIf Range(b & i) = Then Range(c & i) = WK Else Range(c & i) = CJ End If If Range(d & i) = Then Range(D & i).Select Selection.EntireRow.Delete End If NextEnd SubSub gzt()Dim i As IntegerFor i = 3 To 2000 Step 2 If Range(A & i) = Then Exit For End If Rows(1:1).Select Application.CutCopyMode = False Selection.Copy Range(A & i).Select Selection.Insert Shift:=xlDown NextEnd Sub