VBA将目录表下相同公司的记录提取出来并生成以公司名称命名的工作表

截图不截列表行标都是耍LIUMANG。

给你标准代码，自己去修改吧。

Sub 拆分数据()

Dim i, j, l As Integer '拆分数据表的列号

Dim irow As Integer

Dim sh As Worksheet '拆分后生产的工作表

Dim sht As Worksheet '原有工作薄中所有的sheet

Dim sh0 As Worksheet '定义活动工作表为sh0

Set sh0 = ActiveSheet '活动工作表赋值给sh0

irow = sh0Range("a65536")End(xlUp)Row

l = InputBox("请输入拆分表依据的列号：")

'删除原有工作薄中多余表格

ApplicationDisplayAlerts = False

If SheetsCount > 1 Then

For Each sht In Sheets

If shtName <> sh0Name Then

shtDelete

End If

Next

End If

ApplicationDisplayAlerts = True

'1 按销售新建工作表

For i = 2 To irow

k = 0

For Each sh In Sheets

If shName = sh0Cells(i, l) Then

k = 1

End If

Next

If k = 0 Then

SheetsAdd(after:=Sheets(SheetsCount))Name = sh0Cells(i, l)

End If

Next

'2筛选并复制数据到对应表格

For j = 2 To SheetsCount

sh0Range("a1:az" & irow)AutoFilter field:=l, Criteria1:=Sheets(j)Name

sh0Range("a1:az" & irow)Copy Sheets(j)Range("a1")

Next

sh0Range("1:1")AutoFilter

sh0Select

End Sub

VBA命名工作表，直接用worksheets(需要改名的工作表的索引号或名称)name即可

本工作表名，直接用Thisworkbookname可以获得

 故要实现题目中命名工作表的要求，可以采用下面的代码实现——

Sub ReName()

   For i = 1 To WorksheetsCount

       Worksheets(i)Name = ThisWorkbookName & "-" & i

   Next

End Sub

在当前工作表的A列生成结果：

    Dim ar(1 To 100, 1 To 1)

    Dim i As Long, j As Long

    For i = 1 To SheetsCount

        If Sheets(i)Visible = xlSheetVisible Then

            j = j + 1

            ar(j, 1) = Sheets(i)Name

        End If

    Next i

    With ActiveSheetCells(1, 1)

        Resize(RowsCount)ClearContents

        Resize(j) = ar

    End With

End Sub

hx95华夏联盟

以上就是关于VBA将目录表下相同公司的记录提取出来并生成以公司名称命名的工作表全部的内容，包括:VBA将目录表下相同公司的记录提取出来并生成以公司名称命名的工作表、vba 命名工作表名、excel VBA中如何提取没有被隐藏的工作表的名称等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！