精华内容
下载资源
问答
  • 此脚本用于根据sheet1中的第一列从第三行开始的数据新建工作簿并重命名 '2.复制第一列和对应的列的值 '3.调整新建工作簿的列宽 ScreenUpdating = False '关闭屏幕刷新 Dim sCount As Long '列数 Dim sCol As ...
    Sub addRe()
        '1.此脚本用于根据sheet1中的第一列从第三行开始的数据新建工作簿并重命名
        '2.复制第一列和对应的列的值
        '3.调整新建工作簿的列宽
        ScreenUpdating = False '关闭屏幕刷新
        Dim sCount As Long     '列数
        Dim sCol As Long       '行数
    
        Dim rnG1 As Range '第一列区域
        Dim rnG2 As Range '第二列区域
        Dim rn As Range   '第一列的开头
        Dim arr1() '第一列的数组(静态)
        Dim arr2() '第二列的数组(动态)
    
        Set rn = Sheet1.Cells(2, 1) '读出新工作簿要用的第一列的开头
        Set rnG1 = Sheet1.Range(rn, rn.End(xlDown)) '读出新工作簿要用的第一列的区域
            sCount = Sheet1.Range("A2").CurrentRegion.Columns.Count - 1 '读出行数
            sCol = rnG1.Rows.Count '读行数
            arr1 = rnG1 '第一列
        Dim arrName() '名字数组
        ReDim arrName(sCount - 1) '调整数组大小
        
        For i = 1 To sCount
            
            Set rn = Sheet1.Cells(2, i + 1) '读出新工作簿要用的第二列的开头
            Set rnG2 = Sheet1.Range(rn, rn.End(xlDown)) '读出新工作簿要用的第二列的区域
            arr2 = rnG2 '转换为数组
            Sheet1.Activate
            Sheets.Add after:=ActiveSheet '新建工作簿
            
            ActiveSheet.Name = Sheet1.Cells(2, i + 1) '工作簿重命名
            arrName(i - 1) = ActiveSheet.Name '记录新建工作簿的名称
            ActiveSheet.Range(Cells(2, 1), Cells(sCol, 1)) = arr1 '第一列赋值
            ActiveSheet.Range(Cells(2, 2), Cells(sCol, 2)) = arr2 '第二列赋值
            
            Columns("A:B").EntireColumn.AutoFit '调整选中所有新建的工作簿AB列的列宽
        Next i
    
        Sheet1.Activate '回到Sheet1工作簿
        ScreenUpdating = True '打开屏幕刷新
    End Sub
    
    
    

    在我写完上面的代码之后很快就被啪啪打脸了:

    下面这个简单高效,结果一样还保留了格式。。。

    Sub fz()
        Dim a As Byte
        For a = 2 To Cells(2, Columns.Count).End(xlToLeft).Column
            With Sheets.Add(after:=Sheets(Sheets.Count))
                .Name = Worksheets(1).Cells(2, a)
                Worksheets(1).Select
                Worksheets(1).Columns(1).Copy .Range("a1")
                Worksheets(1).Columns(a).Copy .Range("b1")
            End With
        Next a
    End Sub
    

     

     

    表格内容大概是这样的:

         
    时间J2-01(JD0280)_位移(mm)J2-02(JD0267)_位移(mm)J2-03(JD0282)_位移(mm)J2-04(JD0275)_位移(mm)
    2019-07-30-0.14-0.24-0.2-0.26
    2019-07-29-0.14-0.24-0.2-0.26
    2019-07-28-0.14-0.23-0.19-0.26
    2019-07-27-0.14-0.23-0.19-0.26
    2019-07-26-0.13-0.23-0.19-0.26
    2019-07-25-0.13-0.23-0.18-0.25
    2019-07-24-0.13-0.22-0.18-0.25
    2019-07-23-0.13-0.22-0.18-0.25
    2019-07-22-0.13-0.22-0.17-0.24
    2019-07-21-0.13-0.22-0.17-0.25
    2019-07-20-0.12-0.21-0.16-0.24
    2019-07-19-0.12-0.21-0.15-0.24
    2019-07-18-0.12-0.2-0.14-0.23
    2019-07-17-0.12-0.21-0.16-0.24
    2019-07-16-0.12-0.2-0.14-0.23
    2019-07-15-0.11-0.19-0.12-0.22
    2019-07-14-0.11-0.19-0.11-0.21
    2019-07-13-0.1-0.18-0.11-0.21
    2019-07-12-0.11-0.19-0.12-0.21
    2019-07-11-0.11-0.19-0.12-0.22
    2019-07-10-0.11-0.19-0.11-0.21
    2019-07-09-0.1-0.18-0.1-0.21
    2019-07-08-0.1-0.18-0.1-0.21
    2019-07-07-0.1-0.18-0.1-0.21
    2019-07-06-0.1-0.18-0.1-0.21

    结果是这样的:

    展开全文
  • EXCEL VBA创建sheet/工作簿

    万次阅读 2019-05-29 11:02:34
    1.需要创建以地市命名的系列sheet,但不想手动创建改名。 代码实现如下: Sub SheetAdd() ... Sheets.Add After:=Sheets(Sheets.Count), Count:=Sheets(1).Range("A" & Rows.Count).End(...

    1.需要创建以地市命名的系列sheet,但不想手动创建改名。

    sheet名称
    代码实现如下:

        Sub SheetAdd()
        
        Dim i As Long
        
        '定义一个长整型变量
        
        Sheets.Add After:=Sheets(Sheets.Count), Count:=Sheets(1).Range("A" & Rows.Count).End(xlUp).Row - 1
        
        '在现有Sheet后新建工作表,工作表数量等于Sheet(1)表A列非空单元格行数
        
        For i = 2 To Sheets.Count
        
        Sheets(i).Name = Sheets(1).Cells(i, 1).Value
        
        '工作表名称设置为Sheet(1)A列单元格值
        
        Next
        
        MsgBox "创建工作表完成!"
        
        End Sub
    

    完成后如图:
    创建完成图

    2.那么,创建完成后需要把系列sheet分离成独立的工作簿该如何呢,

    VBA实现代码如下:

        Sub 拆分工作簿()
        
        Dim sht As Worksheet '定义一个工作表变量 sht
        
        Dim mybook As Workbook '定义一个工作簿变量 mybook
        
        Application.ScreenUpdating = False '关闭屏幕更新:作用为加快宏的执行速度,这样将看不到宏的执行过程,但宏的执行速度加快了。
        
        Set mybook = ActiveWorkbook '将当前工作簿赋值给变量 mybook
        
        For Each sht In mybook.Sheets ' FOR 循环实现将工作簿中的多个工作表拆开成以工作表名称命名的工作簿并保存在原工作簿相同的路径中
        
        sht.Copy
        
        ActiveWorkbook.SaveAs Filename:=mybook.Path & "\" & sht.Name, FileFormat:=xlNormal
        
        ActiveWorkbook.Close
        
        Next
        
        Application.ScreenUpdating = True '恢复屏幕刷新 ,屏幕刷新 False /True 需成对出现 。
        
        MsgBox "工作簿已经拆分完毕"
        
        End Sub
    

    完成如图:
    拆分工作簿完成图

    3.以上两个步骤可以归纳为:按指定名称批量创建Excel工作簿。

    需要创建指定名字的工作簿
    VBA代码实现如下:

        Sub Createwks()
        
            Dim i&, p$, r
        
            Application.ScreenUpdating = False
        
            '取消屏幕刷新
        
            Application.DisplayAlerts = False
        
            '取消警告提示,当有重名工作簿时直接覆盖
        
            p = ThisWorkbook.Path & "\"
        
            '当前工作簿所在的路径
        
            r = [a1].CurrentRegion '数据装入数组r
        
            For i = 2 To UBound(r)
        
            '标题不要,因此从第2个元素开始遍历数组r
        
                With Workbooks.Add '新建工作簿
        
                    .SaveAs p & r(i, 1), xlWorkbookDefault
        
                    '保存工作簿
        
                    .Close True
        
                    '关闭工作簿
        
                End With
        
            Next
        
            Application.ScreenUpdating = True
        
            Application.DisplayAlerts = True
            MsgBox "工作簿已经创建完毕"
        
        End Sub
    

    完成后如图:
    创建工作簿

    展开全文
  • 一、需求 根据sheet1所列名称,添加...Sub cre_ren_sheets() Dim num% /* 定义为integer*/ num = Application.WorksheetFunction.CountA(Sheet1.Range("A:A")) /* num是非空单元格数*/ For i = 1 To num ...
    一、需求

    根据sheet1所列名称,添加并重命名新的工作表。
    在这里插入图片描述

    二、实现
    1.按照从前往后的顺序
    Sub cre_ren_sheets()
    	Dim num% 
    	/* 定义为integer*/
    	num = Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
    	/* num是非空单元格数*/
    	
    	For i = 1 To num
    	    Sheets.Add after:=ActiveSheet
    	    Sheets(i + 1).Select
    	    Sheets(i + 1).Name = Sheet1.Cells(i, 1)
    	Next i
    End Sub
    

    在这里插入图片描述

    2.按照从后往前的顺序
    Sub cre_ren_sheets()
    	Dim num%
    	num = Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
    	
    	For i = 1 To num
    	    Sheets.Add
    	    Sheets(1).Name = Sheet1.Cells(i, 1)
    	    /* Sheet1=Sheets(i+1), sheet1随着新工作表的建立被往后挤,序列数随之增大*/
    	Next i
    End Sub
    
    

    在这里插入图片描述

    三、注意事项
    1.代码中的索引号和新建sheet默认命名不一定一致,代码按照顺序,工作簿只是名称。

    在这里插入图片描述

    2.工作表的命名要求

    在这里插入图片描述

    展开全文
  • VBA-新建工作簿

    2020-02-26 12:09:43
    新建工作簿 这节内容介绍如何应用VBA自动创建工作簿,并修改部分内容后保存关闭。和创建工作表类似,创建工作簿仍然使用add方法。下面是一个较为完整的创建例子: Sub addnewbook() Dim i As Integer Dim shtname ...

    新建工作簿

    这节内容介绍如何应用VBA自动创建工作簿,并修改部分内容后保存关闭。和创建工作表类似,创建工作簿仍然使用add方法。下面是一个较为完整的创建例子:

    Sub addnewbook()
        Dim i As Integer
        Dim shtname As Variant
        Dim newbook As Workbook
        Dim arr As Variant
        Dim sht As Worksheet
        
        shtname = Array("a", "b", "c", "d") '新建工作簿中工作表名称
        arr = Array("1", "2", "3", "4", "5", "6") '工作表中内容
        
        Set newbook = Workbooks.Add '创建工作簿
        With newbook
            .ActiveSheet.Name = shtname(0)
            For i = 2 To 4
                .Sheets.Add after:=.Sheets(newbook.Sheets.Count) '创建工作表
                .ActiveSheet.Name = shtname(i - 1) '更改工作表名字
            Next
            
            For Each sht In .Worksheets
                sht.Range("a1").Resize(1, 6) = arr '修改工作表中内容
            Next
            .SaveAs Filename:="D:\data\1.xlsx" '设置保存路径
            .Close savechanges = True '确定可以更改
        End With
    End Sub
    
    展开全文
  • VBA之sheet页的生成

    千次阅读 2019-05-26 17:27:58
    在生成sheet页中有几种常用的方法,这里整理一下: 1.直接生成sheet页: Worksheets.add '直接生成sheet Activesheets.name = "sheet1" ‘给当前生成的sheet页命名为sheet1 2.生成的sheet页在指定的页面前面 ...
  • VBA --Sheets.Add 方法

    万次阅读 2011-12-13 09:25:46
    Sheets.Add 方法 新建工作表、图表或宏表。新建的工作表将成为活动工作表。 语法 表达式.Add(Before,After,Count, Type) 表达式 一个代表 Sheets 对象的变量。 参数 名称 必选/可选 数据...
  • EXCEL-VBA:Sheet是否存在、新建Sheet、Sheet改名
  • 新建工作表的这条路上踩过太多的坑了,虽然仅有个别的项目才需要用到新建工作表,但是很久不用,难免习惯性的baidu,然后就是一大堆乱七八糟的搜索结果:1、代码独立,获取不到新建工作表对象,无法在后续调用中...
  • Sub a() Dim myApp As Application Dim Sh As Worksheet Dim Temp As String Dim k As Integer Set myApp = New Application Temp = "G:\Excel之路\1.xls" Set Sh = myApp.Workbooks.Open(Temp).Sheets("监督记录") ...
  • vba 创建excel 文件

    万次阅读 2017-02-10 10:01:12
    sub Create(paths,files) Dim w As Workbook  Set w = Application.Workbooks.Add ... w.SaveAs Filename:=paths & "\" & files & ".xlsx" '在此输入新建工作簿的文件名,包括完整路径和扩展名
  • sub 批量新建指定名称的工作表() Dim i As Integer For i = 2 To 10 '根据实际情况修改i大小 Worksheets.Add after:=Worksheets(ThisWorkbook.Worksheets.Count) ActiveSheet.Name = Sheets(1).Cells(1, i) ...
  • VBA之用set来新建

    2020-03-30 19:21:43
    如何用set来新建表 Sub test() Dim sht As Worksheet For i = 2 To 5 Set sht = Sheets.Add sht.Name = Sheet1.Range(“a” & i) Next End Sub
  • vba copy sheet

    千次阅读 2019-07-11 17:33:54
    Sub copySheet() Dim wkbk As Workbook Set wkbk = Workbooks.open("源文件.xls") '先打开要复制的文件 wkbk.sheets(1).Copy thisworkbook.sheets(1) '再将此文件中第一个工作表复制到当前工作簿的第一个工作表前 ...
  • vba新建Sheet中自动插入代码

    千次阅读 2012-06-13 22:05:22
    首先,感谢ExcelHome中youhm所提供的帮助! 在 工具-宏-安全性-可靠发行商 里要激活“信任对Visual Basic 项目的访问” ...With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule ...
  • 1. 界面如下, 2. 术语列表 3. VBA代码: Public Sub saveTerm() Dim iCount As Integer Application.ScreenUpdating = False '把工作表的记录数赋予... iCount = Sheets("Term").[A1].CurrentRegion.Rows.C
  • Private Sub Workbook_Open() Dim str As String Dim a As Worksheet ... Set w = CreateObject("word.application") ‘新建word文档  w.Visible = True  w.Documents.Add  For Each s In Worksheets 
  • Do While Workbooks("C:\VBA\cs2.xlsm").Sheets("create").Cells(i, 1) <> "" '不用指定循环数,但中间有空还是不行 wb.Worksheets.Add after:=wb.Worksheets(Worksheets.Count) '新表往前放置 wb.ActiveSheet....
  • VBA新建工作簿

    2013-11-13 14:32:00
    这就需要在vba新建、保存excel文件。掌握几个东西就能很熟练了:1、要想保存在当前目录下,需要调用thisworkbook.path得到当前文件的目录,得到的就是个string值,如“e:\download”。我通常是先定义一个string...
  • 【关键步骤】从开发工具里打开Visual Basic, 新建模块1,将以下代码复制到里面,保存,关闭代码窗口。Public Sub 一键获取本文件夹工作表()Application.ScreenUpdating = FalseDim f As String, i As IntegerDim wb ...
  • '3 excel文件新建和保存 Sub W3() Dim wb As Workbook Set wb = Workbooks.Add wb.Sheets( "sheet1" ).Range( "a1" ) = "zch19960629" wb.SaveAs "D:\B.xls" End Sub '4 excel文件打开和...
  • VBA 图表的基本操作(二)

    千次阅读 2020-08-13 23:26:06
    今天继续讲讲VBA图表的相关操作 一、在图表工作表上创建图表(看起来有点拗口,也就是在Chart上创建一个图表) 插入图表的方式:打开工作簿后,对着sheet点一下右键——插入——选择图表。 ①昨天主要是讲了...
  • 上一篇文,我们初步了解了VBA,现在我们进入Excel应用篇。我们都知道,我们日常工作中操作数据的表,我们称之为工作表,就是我们常见的sheet,而多张sheet组成了工作簿。熟悉Excel函数的小伙伴应该都知道,我们经常...
  • 工作表的添加和删除 ...before:指定新建的工作表在该表格之前 after:指定新建的工作表在该表格之后 count:指要建立的工作表数量 type:指要建的工作表类型 '在所有表的后面新建表 Sub test() Workshee...
  • 使用vba操作工作表,实现报表汇总

    千次阅读 2020-07-07 10:53:49
    假设工作簿中按顺序新建3张表叫1月和2月和3 月。如何切换到第2张表? Sheet2.select //sheet2是表的默认名称。重命名只是给sheet2起一个别名 Sheets(2).select //sheets(2)指工作簿的第2张表 Sheets(“2月”)....
  • VBA新建、读取、保存和另存EXCEL

    万次阅读 2009-01-09 21:34:00
    如果该值为 False(默认值),则以 Visual Basic for Applications (VBA) 的语言保存文件,其中 Visual Basic for Applications (VBA) 为典型安装的美国英语版本,除非 VBA 项目中的 Workbooks.Open 来自旧的国际化...
  • 参数Before及After均是可选,用来确定新工作表放的位置,如果都不指定则新建一个工作薄。不同同时指定Before及After,只能指定其中一个。 Private Sub test()  Worksheets("sheet2").Copy before:=Worksheets...
  • vba_emailcheck

    2021-09-16 16:07:30
    6) = arr3(i, 6) Cells(j, 7) = arr3(i, 7) j = j + 1 End If Next i book1.Sheets(1).[a1].Select 'dp code Set con = CreateObject("adodb.connection") Set rst = CreateObject("ADODB.recordset") con.Open ...
  • 目录 示例 实现代码 工作表对象... 在VBA编程时,执行的代码同样会触发警告信息,该警告信息会破坏VBA程序的连续性。因而,在程序开始前,将DisplayAlerts设置为False,然后在结束程序前将DisplayAlerts设置为True。
  • VBA 工作表 worksheet.add 方法

    千次阅读 2020-01-31 10:36:01
    1 工作表 sheet的添加 worksheets.add 或 sheets.add 1.1 基本语法 Sheets.Add 方法 新建工作表、图表或宏表。新建的工作表将成为活动工作表。 语法 表达式.Add(Before, After, Count, Type) 表达式 一个代表 ...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 1,251
精华内容 500
关键字:

vba新建sheets