VBA写excel宏

Sub zzz()
'
' zzz 宏
'

'

    'ActiveWorkbook.Names.Add Name:="S941.群众团体", RefersToR1C1:="=Sheet3!R1C6:R1C6"
    'ActiveWorkbook.Names("S941.群众团体").Comment = ""
    'ActiveSheet.Cells(1, 1).Value = "HYTX4"
    For i = 2 To 443
   
        m = ActiveSheet.Cells(i, 4).Value '获取行业投向三级
        j1 = 0
        For j = 2 To 1076
            n = ActiveSheet.Cells(j, 6).Value '获取行业投向四级
           
           
            If Mid(m, 1, 4) = Mid(n, 1, 4) Then
               
                j1 = j1 + 1
            Else
                If j1 <> 0 Then
                    Exit For
                End If
            End If
        Next j
           
             If j1 <> 0 Then
                    j2 = j - j1
                    'If j <> 1076 Then
                        j = j - 1
                    'End If
                    o = "=Sheet3!R" & j2 & "C6:R" & j & "C6"
                    ActiveSheet.Cells(1, 1).Value = m
                    ActiveSheet.Cells(2, 1).Value = n
                    ActiveSheet.Cells(3, 1).Value = o
                    ActiveSheet.Cells(4, 1).Value = j
                    ActiveSheet.Cells(5, 1).Value = j1
                    ActiveWorkbook.Names.Add Name:=m, RefersToR1C1:=o
             End If
       
    Next i
   
End Sub
---------------------------------------------------------------------------------
Sub bbb()
'
' bbb 宏
    j = 0
    For i = 3 To 30
        m = Sheet1.Cells(i, 1).Value '获取机构号
        j = j + 1
        k = i + 1
        n = Sheet1.Cells(k, 1).Value '获取机构号
        If m <> n Then
            Sheets.Add After:=Sheets(Sheets.Count)
           
           
            Worksheets("Sheet1").Activate
            Rows("1:3").Select
            Selection.Copy
            Sheets(Sheets.Count).Activate
            Range("A1").Select
            ActiveSheet.Paste
           
            Worksheets("Sheet1").Activate
            Rows(i - j + 1 & ":" & k - 1).Select
            Selection.Copy
            Sheets(Sheets.Count).Activate
            Range("A3").Select
            ActiveSheet.Paste
            ActiveSheet.Name = m
            j = 0
        End If
    Next i
End Sub

------------------------------------------------------------------------------------------

Sub CTL()
D_TABLE = Trim(ActiveSheet.Cells(1, 5))
FILE_PATH = Trim(ActiveSheet.Cells(2, 14))
If FILE_PATH = "" Then
    FILE_PATH = "E:\vba-test\SP_" + D_TABLE + ".txt"
End If

n = ActiveSheet.UsedRange.Rows.Count

Dim FS2
Set FS2 = CreateObject("SCRIPTING.FILESYSTEMOBJECT")
Set CTL_FILE = FS2.CREATETEXTFILE(FILE_PATH, True)
S_TABLE = Trim(ActiveSheet.Cells(1, 3))

PROC_START = "create or REPLACE procedure " + D_TABLE + "(IN  ETLDATE VARCHAR(8),--业务日期" + vbCrLf + "OUT  O_RETURN NUMERIC--返回值"
PROC_START = PROC_START + vbCrLf + vbTab + "INSERT INTO" + D_TABLE + "(" + vbCrLf + vbTab + vbTab
CTL_FILE.WRITELINE (PROC_START)

For I = 4 To n

    PROC = ""
    D_ZD = Trim(ActiveSheet.Cells(I, 5))
    D_COMMENT = Trim(ActiveSheet.Cells(I, 6))
    If I = n Then
        PROC = vbTab + vbTab + vbTab + vbTab + D_ZD + " --" + D_COMMENT
    Else
        PROC = vbTab + vbTab + vbTab + vbTab + D_ZD + ",--" + D_COMMENT
    End If
    CTL_FILE.WRITELINE (PROC)
   
Next
CTL_FILE.WRITELINE (vbCrLf + ")" + vbCrLf + vbTab + vbTab + "SELECT" + vbCrLf + vbTab + vbTab)

For I = 4 To n

    PROC = ""
    S_ZD = Trim(ActiveSheet.Cells(I, 1))
    S_COMMENT = Trim(ActiveSheet.Cells(I, 2))
    If I = n Then
        PROC = vbTab + vbTab + vbTab + vbTab + S_ZD + ",--" + S_COMMENT
    Else
        PROC = vbTab + vbTab + vbTab + vbTab + S_ZD + ",--" + S_COMMENT
    End If
    CTL_FILE.WRITELINE (PROC)
Next
CTL_FILE.WRITELINE (vbCrLf + vbTab + vbTab + "FROM " + S_TABLE)
CTL_FILE.Close
MsgBox ("文件" + FILE_PATH + " 创建完毕")
End Sub