[求助]将sheet按模板拆分成多个个人工作表sheet？表格不规则

ccbwx

第1个工作表当数据源，第2个工作表当模板，公式就按模板里的把新生成的表放在模板后面，例如

数据源、模板、fk001、fk002……

论坛里的工资例子，好象都是一行对一行的，我这个不是，希望高手能简单写一下，让我学习学习

L46oJh7v.rar (6.31 KB, 下载次数: 63)

2007-9-7 09:32 上传

点击文件名下载附件
[求助]如何用VAB做类似于工资表头一个工作表？有实例

[此贴子已经被作者于2007-9-7 11:08:56编辑过]

yuanzhuping

请搜索"工资表“，坛中有大量实例。

ccbwx

论坛里的工资例子，我下载了几个好象都是一行对一行的对应的或者是查询用的

我刚刚学习VBA，希望高手能简单写一下，指点一下，让我好学习学习

谢谢各位老师了！

xmh850216

Sub Macro1()
Dim sht, NewSht As Worksheet
Dim myName As String
Dim i As Integer
On Error Resume Next
For i = 2 To Sheet2.[a65536].End(xlUp).Row
myName = Sheet2.Cells(i, 1).Value
Set NewSht = ThisWorkbook.Sheets(myName)

If NewSht Is Nothing Then
Set NewSht = ActiveWorkbook.Sheets.Add
NewSht.Name = myName
Sheet3.Cells.Copy NewSht.[a1]

NewSht.[b3] = Sheet2.Cells(i, 2)
NewSht.[e3] = Sheet2.Cells(i, 3)
NewSht.[b4] = Sheet2.Cells(i, 4)
NewSht.[g3] = Sheet2.Cells(i, 5)
NewSht.[e4] = Sheet2.Cells(i, 6)
NewSht.[g4] = Sheet2.Cells(i, 7)
NewSht.[d5] = Sheet2.Cells(i, 8)
NewSht.[b5] = Sheet2.Cells(i, 9)
NewSht.[f5] = Sheet2.Cells(i, 10)
NewSht.[h5] = Sheet2.Cells(i, 11)

Else

Sheet3.Cells.Copy NewSht.[a1]

NewSht.[b3] = Sheet2.Cells(i, 2)
NewSht.[e3] = Sheet2.Cells(i, 3)
NewSht.[b4] = Sheet2.Cells(i, 4)
NewSht.[g3] = Sheet2.Cells(i, 5)
NewSht.[e4] = Sheet2.Cells(i, 6)
NewSht.[g4] = Sheet2.Cells(i, 7)
NewSht.[d5] = Sheet2.Cells(i, 8)
NewSht.[b5] = Sheet2.Cells(i, 9)
NewSht.[f5] = Sheet2.Cells(i, 10)
NewSht.[h5] = Sheet2.Cells(i, 11)

End If
Next
End Sub

[此贴子已经被作者于2007-9-9 12:22:41编辑过]

samuce

看 纟纟纟纟纟纟

fdd

Sub addSheet()
    On Error GoTo lab
    With ThisWorkbook
        Set rngname = .Sheets("数据源").Range("a:a")
        Set rngword = .Sheets("数据源").Range("1:1")
        For Each temp In rngname
            If temp.Row <> 1 And temp.Value <> "" Then
                .Sheets("模板").Copy after:=.Sheets(.Sheets.Count)
                .Sheets(.Sheets.Count).Name = temp.Value
                .Sheets(.Sheets.Count).[a65536].Select
                i = 0
                For Each temp2 In rngword
                    If temp2.Value <> "" Then
                        Debug.Print i
                        Set rngtemp = .Sheets(.Sheets.Count).Cells.Find(what:="*" & temp2.Value & "*", lookat:=xlWhole)
                        If Not rngtemp Is Nothing Then
                            rngtemp.Offset(, 1).Value = temp.Offset(, i).Value
                        End If
                    End If
                    i = i + 1
                Next
                .Sheets(.Sheets.Count).[a1].Select
            End If
        Next
    End With
    Exit Sub
lab:
    MsgBox "可能是工作表重名了！请检查。"
    If ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name Like "*模板*" Then
        Application.DisplayAlerts = False
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Delete
        Application.DisplayAlerts = True
    End If
   

End Sub

LMY123

FIND查找学习中

jjmysjg

xmh850216 发表于 2007-9-8 02:01
Sub Macro1()Dim sht, NewSht As WorksheetDim myName As StringDim i As IntegerOn Error Resume NextFor  ...

只建立一个表，不能继续