VBA按当前单元格的某些值 新建一个这个名称的工作表

原问题：VBA按当前单元格的某些值 新建一个这个名称的工作表
分类：编程开发 > 最后更新时间：【2017-07-28 10:05:32】
问题补充：

VBA按当前单元格的某些值 新建一个这个名称的工作表.

【这是一张补货表，要把每个店铺的补货数据统计到每个工作表中】

最佳答案

用for循环横向列标 然后if判断当公司对应的下方有值的时候，提取公司名新建sheet，把sheet名字改成对应的公司名，然后在按照有数量的单元格把对应的数据复制到对应的公司即可


追问：
你可以帮我写下吗？我写着写着就不知道怎么写了 追答：
Sub FLeitText()Application.ScreenUpdating = FalseDim Row_i As Integer, RowMax As Long, Column_j As Integer, ColumnMax As LongRowMax = Cells(Rows.Count, 1).End(3).rowColumnMax = Cells(1, Columns.Count).End(1).ColumnDim k As Integerk = 1Dim ArrArr = Range(Cells(1, 1), Cells(RowMax, ColumnMax))For Column_j = 5 To ColumnMax Dim Sht As Worksheet On Error Resume Next Set Sht = Sheets(Arr(1, Column_j)) If Sht Is Nothing Then Worksheets.Add(after:=Worksheets(Sheets.Count)).Name = Arr(1, Column_j) ActiveSheet.[a1].Resize(1, 5) = Array("货号", "货品名称", "颜色", "尺码", "数量") End If For Row_i = 2 To RowMax If Arr(Row_i, Column_j) <> "" Then k = k + 1 Sheets(Arr(1, Column_j)).Cells(k, 1) = Arr(Row_i, 1) Sheets(Arr(1, Column_j)).Cells(k, 2) = Arr(Row_i, 2) Sheets(Arr(1, Column_j)).Cells(k, 3) = Arr(Row_i, 3) Sheets(Arr(1, Column_j)).Cells(k, 4) = Arr(Row_i, 4) Sheets(Arr(1, Column_j)).Cells(k, 5) = Arr(Row_i, Column_j) End If Next k = 1NextApplication.ScreenUpdating = TrueEnd Sub
追问：
Sub aa()n = 12y = 11Dok = 1s = Trim(Sheet1.Cells(1, n).Text) If Sheet1.Cells(1, n) > 1 Then Sheets.Add.Name = s Elsen = n + 1y = y + 1End If For i = 2 To Sheet1.Range("l536").End(3).Row If Sheet1.Cells(i, 12) >= 1 Then k = k + 1 Sheets(s).Cells(k, 1) = Sheet1.Cells(i, 1) Sheets(s).Cells(k, 2) = Sheet1.Cells(i, y)End IfNextLoopEnd Sub哈哈，我自己写了一个也可以了，不过在取到重复的工作表名子就报错了。老师可以教我下，用什么语句是判断，如果单元格的名称和工作表是一样，那么就不新增吗？
追问：
取出来，但是数量为0的不取，要怎么填哪里呢？ 追答：
写一个判断就好了，当数量列不为空的时候取值
  • 追答：
    数量单元格不为空
    最佳答案由网友  梧桐秋_雨寒  提供
    • 公告： 为响应国家净网行动，部分内容已经删除，感谢网友理解。
    1

    分享到：

    其他回答

    其它网友回答：
    原始状态

    其它网友回答：
    1、插入模块，编辑代码

    其它网友回答：
    Sub test()

    其它网友回答：
        Dim r%, c%, s$, i%, j%, k%

    其它网友回答：
            r = Application.CountA(Sheets("Sheet1").Range("A:A"))

    其它网友回答：
            c = Application.CountA(Sheets("Sheet1").Range("1:1"))

    其它网友回答：
        For i = c To 5 Step -1

    其它网友回答：
            Sheets("Sheet1").Copy After:=Sheets("Sheet1")

    其它网友回答：
            s = Sheets("Sheet1").Cells(1, i)

    其它网友回答：
            Sheets("Sheet1 (2)").Name = s

    其它网友回答：
            Sheets(s).Select

    其它网友回答：
        For j = c To 5 Step -1

    其它网友回答：
            If j <> i Then Columns(j).Delete Shift:=xlToLeft

    其它网友回答：
        Next j

    其它网友回答：
            Range("E1") = "数量"

    其它网友回答：
            Range("A1:E1").Select

    其它网友回答：
            With Selection

    其它网友回答：
                .WrapText = False

    其它网友回答：
                .Font.Bold = False

    其它网友回答：
                .Font.ColorIndex = xlAutomatic

    其它网友回答：
                .Interior.Color = 65535

    其它网友回答：
            End With

    其它网友回答：
            Columns("A:E").EntireColumn.AutoFit

    其它网友回答：
            Range("A1").Select

    其它网友回答：
        For k = r To 2 Step -1

    其它网友回答：
            If Cells(k, 5) = "" Then Rows(k).Delete Shift:=xlUp

    其它网友回答：
        Next k

    其它网友回答：
        Next i

    其它网友回答：
    End Sub

    其它网友回答：

    其它网友回答：

    其它网友回答：
    2、运行代码

    其它网友回答：

    其它网友回答：

    其它网友回答：

    其它网友回答：


    追答：
    南京慕斯荟
    追答：
    西安益田
    追答：
    靖江的数据工作表
    追答：
    此代码的编辑思路，与手动操作相仿。 1、复制Sheet1工作表5个； 2、重命名这5个工作表的名称，分别为E1~I1单元格的值； 3、对这5个工作表的每一个进行操作：删除多余的列和数据是空格的行； 4、选择这5个工作表，在E1单元格输入“数量”二字，选择表头A1：E1设置格式。
    追答：
    我的百度网盘链接：http://pan.baidu.com/s/1o8boyvS 密码：4e5d
      推荐