Dim i As Integer
Dim j As Integer
Dim intRow As Integer
For i = 1 To ThisWorkbook.Sheets.Count
    ThisWorkbook.Sheets(i).Activate
    Columns("A:A").Select
    Selection.Find(What:="profile", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
    intRow = ActiveCell.Row
    If intRow < 31 Then
        Rows(intRow & ":" & intRow).Select
        For j = intRow To 30
            Selection.Insert Shift:=xlDown
        Next j
        
    End If
   
Next i
把上面的代码放到Workbook_Open()中

帮2楼简化了一下代码。