vba代码

Sub Macro1()

‘复制工作表到多个工作薄中

Dim MyPath$, MyName$, sh As Worksheet

 

' Application.ScreenUpdating = False

    '关闭屏幕更新

 Application.DisplayAlerts = False

  '关闭警告信息

 

  Set sh = Worksheets(1)

 

    MyPath = ThisWorkbook.Path

 

   MyName = Dir(MyPath & "\*.xls")

    On Error Resume Next

 

   Do While MyName <> ""

        If MyName <> ThisWorkbook.Name Then

 

           m = m + 1

           Cells.Select

    Selection.Copy

          

Workbooks.Open ThisWorkbook.Path & "\" & MyName

 

        ActiveWorkbook.Sheets("封面").Select

 

           ActiveSheet.Paste Destination:=Worksheets("封面").Cells

    ActiveSheet.Name = "行政事业性项目和专项资金绩效目标表"

  Application.CutCopyMode = False

  Range(a1).selece

  ActiveWorkbook.Save

   ActiveWorkbook.Close 1

     End If

        MyName = Dir

 

   Loop

 

   ' Application.ScreenUpdating = True

   Application.DisplayAlerts = True

 

   MsgBox "处理完毕，共处理" & m & "个工作簿"

 

End Sub

 

 

 

 

Sub gs()

‘复制工作表中公式到多个工作薄中

 

Dim MyPath$, MyName$

 

' Application.ScreenUpdating = False

    '关闭屏幕更新

 

  Application.DisplayAlerts = False

  '关闭警告信息

 MyPath = ThisWorkbook.Path

 

     MyName = Dir(MyPath & "\*.xls")

    On Error Resume Next

 

   Do While MyName <> ""

        If MyName <> ThisWorkbook.Name Then

 

           m = m + 1

          Range("c6").Select

           Selection.Copy

           

Workbooks.Open ThisWorkbook.Path & "\" & MyName

 

 

    Windows(" MyName").Activate

    Sheets("部门一般公共预算经济分类支出表").Select

     Range("c6").Select

    ActiveSheet.Paste

  

      ActiveWorkbook.Save

       ActiveWorksheet.Paste

       Application.CutCopyMode = False

       ActiveWorkbook.Save

       ActiveWorkbook.Close

 ' sh.Copy after:=Sheets(10)

 

       ' ThisWorkbook.Close True

 

 

     End If

        MyName = Dir

 

   Loop

 

   ' Application.ScreenUpdating = True

   Application.DisplayAlerts = True

 

   MsgBox "处理完毕，共处理" & m & "个工作簿"

 

End Sub

 

Sub 提取文件清单()

Dim k As Integer

Dim myname As String

Dim mypath As String

mypath = ThisWorkbook.Path

myname = Dir(mypath & "\*.xls")

k = 1

Do While myname <> ""

k = k + 1

Range("d" & k) = myname

myname = Dir

Loop

End Sub

用VBA设置列宽和行高

如果要用VBA来设置区域的行高和列宽，可以用Range.ColumnWidth 属性和Range.RowHeight 属性，例如下例将选定的区域中各单元格的列宽和行高调整为指定的数值：

    Sub SetColumnAndRow()
    With ActiveWindow.RangeSelection
      .ColumnWidth = 3
      .RowHeight = 19
    End With
    End Sub

    如果要将选定区域内的各单元格的列宽和行高调整为最合适的值，可以用下面的代码：

    Sub SetColumnAndRow()
    With ActiveWindow.RangeSelection
      .Columns.AutoFit
      .Rows.AutoFit
    End With
    End Sub

    下面的代码将活动工作表中的所有单元格的行高和列宽恢复为默认值：

    Sub SetDefault()
    With ActiveSheet
      .Columns.ColumnWidth = .StandardWidth
      .Rows.RowHeight = .StandardHeight
    End With
    End Sub

 

Sub 批量修改多个工作薄中工作表()

   Dim myname$, i As Worksheet

     Application.DisplayAlerts = False

     On Error Resume Next

      a = Timer

    myname = Dir(ThisWorkbook.Path & "\*.xls")

    Do While myname <> ""

         If myname = ThisWorkbook.Name Then

         GoTo 123

         End If

         Workbooks.Open ThisWorkbook.Path & "\" & myname

       

         For Each i In Worksheets

            i.Activate

            Select Case i.Name

               Case Is = "Z01 收入支出决算批复表(财决批复01表)"

                    ActiveWorkbook.Sheets("Z01 收入支出决算批复表(财决批复01表)").Select

           

                      ActiveSheet.Name = "1、收支决算总表"

                     Range("c1") = "收支决算总表"

                     Range("f2") = "公开1表"

                     [36：50] = ""

                    Range("a36") = "  注：本表反映部门本年度的总收支和年末结转结余情况。 "

                 

                Case Is = "Z03 收入决算批复表(财决批复02表)"

                    ActiveWorkbook.Sheets("Z03 收入决算批复表(财决批复02表)").Select

                    ActiveSheet.Name = "2、收入决算表"

                   Range("g1") = "收入决算表"

                   Range("k2") = "公开2表"

                    Range("a200").End(xlUp)(-2, 1).Resize(6, 7).Value = ""

               

                   Range("a200").End(xlUp)(2.1) = "注：本表反映部门本年度取得的各项收入情况。"

        

               Case Is = "Z04 支出决算批复表(财决批复03表)"

                    ActiveWorkbook.Sheets("Z04 支出决算批复表(财决批复03表)").Select

                    ActiveSheet.Name = "3、支出决算表"

                    Range("f1") = "支出决算表"

                    Range("j2") = "公开3表"

                    Range("a200").End(xlUp)(-2, 1).Resize(6, 7).Value = ""

                    Range("a200").End(xlUp)(2.1) = "注：1.本表反映部门本年度各项支出情况。"

             

                 Case Is = "Z01_1 财政拨款收入支出决算批复表(财决批复04表)"

             

                    ActiveWorkbook.Sheets("Z01_1 财政拨款收入支出决算批复表(财决批复04表)").Select

                    ActiveSheet.Name = "4、财政拨款收入支出决算表"

                    Range("d1") = " 财政拨款收入支出决算表"

                    Range("h2") = "公开4表"

                    Range("a200").End(xlUp)(0, 1).Resize(7, 10).Select

                    Range("a200").End(xlUp)(0, 1).Resize(6, 7).Value = ""

                    Range("a200").End(xlUp)(3.1) = "注：本表反映部门本年度一般公共预算财政拨款和政府性基金预算财政拨款的总收支和年末结转结余情况。"

                 Case Is = "Z07 一般公共预算财政拨款收入支出决算批复表(财决批复05表"

                     ActiveWorkbook.Sheets("Z07 一般公共预算财政拨款收入支出决算批复表(财决批复05表").Select

                    ActiveSheet.Name = "5、一般公共预算财政拨款支出决算表"

                    Range("j1") = "一般公共预算财政拨款支出决算表"

                    Range("q2") = "公开5表"

                    Range("a200").End(xlUp)(-1, 1).Resize(7, 10).Select

                    Range("a200").End(xlUp)(-1, 1).Resize(7, 10).Value = ""

                    Range("a200").End(xlUp)(3.1) = "注：本表反映部门本年度一般公共预算财政拨款支出情况。"

                 Case Is = "Z08_1 一般公共预算财政拨款基本支出决算批复表(财决批复0"

                    ActiveSheet.Name = "6、一般公共预算财政拨款基本支出决算表"

                    Range("e1") = "一般公共预算财政拨款基本支出决算表"

                    Range("i2") = "公开6表"

                    Range("a200").End(xlUp)(0, 1).Resize(7, 10).Select

                    Range("a200").End(xlUp)(0, 1).Resize(7, 10).Value = ""

                    Range("a200").End(xlUp)(3.1) = "注：本表反映部门本年度一般公共预算财政拨款基本支出明细情况。"

                 Case Is = "Z09 政府性基金预算财政拨款收入支出决算批复表(财决批复07"

                    ActiveWorkbook.Sheets("Z09 政府性基金预算财政拨款收入支出决算批复表(财决批复07").Select

                    ActiveSheet.Name = "7、政府性基金收支决算表"

                    Range("j1") = "政府性基金收支决算表"

                    Range("q2") = "公开7表"

                    Range("a200").End(xlUp)(-1, 1).Resize(7, 10).Select

                    Range("a200").End(xlUp)(-1, 1).Resize(7, 10).Value = ""

                    Range("a200").End(xlUp)(3.1) = "注：本表反映部门本年度政府性基金预算财政拨款收入、支出及结转和结余情况。"

                     Range("a200").End(xlUp)(2.1) = "说明：本单位没有政府性基金收入，也没有使用政府性基金安排的支出，故本表无数据。"

                                               

          

              End Select

            

            Next i

             n = n + 1

            ActiveWorkbook.Worksheets.Add after:=Worksheets("7、政府性基金收支决算表")

            ActiveSheet.Name = "8、一般公共预算财政拨款“三公”经费支出决算表"

            Set x = ThisWorkbook.Worksheets("8、一般公共预算财政拨款“三公”经费支出决算表").Range("a1:l10")

            Set y = ActiveWorkbook.Worksheets("8、一般公共预算财政拨款“三公”经费支出决算表").Range("a1")

            x.Copy y

            

            'ActiveWorkbook.Save

           ActiveWorkbook.Close 1

                         

            

123:

         myname = Dir

       

                    Loop

          Application.DisplayAlerts = True

          MsgBox Format(Timer - a, "0.0000")

         

End Sub