VBA自用篇_汇总表20230331

Sub Go0()
  '优化省份,年份 AB两列

  Call addSheet1
  Call GetSheetNames2 '获取sheet表的名字 并赋值
  Call Paste3
  
  
  Columns("B:Z").EntireColumn.AutoFit '自适应列
End Sub
Sub addSheet1() '完全ok
Dim ws As Worksheet

    For Each ws In Worksheets
        If ws.Name = "汇总" Then End
    Next ws
    Worksheets.Add.Name = "汇总"
End Sub
Sub GetSheetNames2()
  Dim i%, ws As Worksheet
  
  Cells(1, 1) = "地区": Cells(1, 2) = "年份"
  
  For i = 1 To Sheets.Count  '汇总表sheet1,i从2开始
      If Sheets(i).Name <> "汇总" Then
        ActiveSheet.Cells(1, i + 1).Value = Sheets(i).Name
      End If
  Next i
  
End Sub
Sub Paste3()
    Dim a(1 To 9), k, i%
    a(1) = "2021年": a(2) = "2020年": a(3) = "2019年"
    a(4) = "2018年": a(5) = "2017年": a(6) = "2016年"
    a(7) = "2015年": a(8) = "2014年": a(9) = "2013年"
   
    For i = LBound(a) To UBound(a)  '遍历所有表格  需要修改从下标1开始XXXX
        Rows_Count = Sheets(1).UsedRange.Rows.Count + 1
        
        'Province
        Sheets(2).Range("A2:A32").Copy
        Sheets("汇总").Range("A" & Rows_Count).Select
        ActiveSheet.Paste
        
        'Year
        Sheets("汇总").Range("B" & Rows_Count & ":" & "B" & Rows_Count + 30) = a(i)
        
        'Value
        For f = 2 To Sheets.Count '表 列 循环
            Worksheets(f).Activate
            Worksheets(f).Range(Cells(2, i + 1), Cells(32, i + 1)).Copy
            
            Sheets("汇总").Activate
            Sheets("汇总").Cells(Rows_Count, f + 1).Select
            ActiveSheet.Paste
        
        Next f
    Next i
        
End Sub

Sub test()
    MsgBox Worksheets(24).Name
    MsgBox Sheets("汇总").Cells(2, 25).Select
End Sub