请求给个插入工作表的代码

zsd5237

在附件文件夹内有2个工作簿：表1和表2，能否在点击表1的命令按扭后，在表2工作簿的工作表标签最后插入1张新的工作表，并以表1工作簿SHEET1单元格B4值为表名。谢谢。

青城山苦丁茶

Sub test()
Dim wk As Workbook
s$ = [b4]
Set wk = Workbooks.Open(ThisWorkbook.Path & "\表2.xls")   '此处用open吧
wk.Sheets.Add , wk.Worksheets(wk.Worksheets.Count)
wk.Worksheets(wk.Worksheets.Count).Name = s
wk.Save
wk.Close         '这里仅仅是关闭而已。用不用都随你
Set wk = Nothing
End Sub

BAIXINGR

你这是个遍历问题，在论坛上搜下，有好多这方面的

zsd5237

BAIXINGR 发表于 2011-11-12 16:06
你这是个遍历问题，在论坛上搜下，有好多这方面的

论坛上只有插入本工作簿的，没有插入其他工作簿的。

zsd5237

这个问题好象很简单，但我确实很难，为什么只能插入本工作簿，而要插入另一个工作簿弄了二天也没弄成，只好求教老师，请出手相助。

BAIXINGR

Sub 遍历引用数据() 'laosanjie 2008-9-5
Dim x As Byte, 路径$, 簿名$, AK As Workbook
Application.ScreenUpdating = False
x = 1
路径 = ThisWorkbook.Path & "\数据表\"
簿名 = Dir(路径 & "*.xls")     '依次找寻指定路径中的*.xls文件
   Do While 簿名 <> ""    '当指定路径中有文件时进行循环
       If 簿名 <> ThisWorkbook.Name Then
         Set AK = Workbooks.Open(路径 & 簿名)   '打开符合要求的文件
            If AK.Sheets(1).Range("A1") <> 0 Then
               With AK.Sheets(1)
                  Range("A" & x) = .Range("A1")
               End With
               Workbooks(簿名).Close False  '关闭源工作簿,并不作修改
               x = x + 1
            End If
       End If
       簿名 = Dir   '找寻下一个*.xls文件
   Loop
Application.ScreenUpdating = True
End Sub
这个你可以根据自己的要求修改下

zsd5237

BAIXINGR 发表于 2011-11-12 21:35
Sub 遍历引用数据() 'laosanjie 2008-9-5
Dim x As Byte, 路径$, 簿名$, AK As Workbook
Application.Scr ...

对不起，这不是我想要的，我的目的是：以表1工作簿C4单元格的字符数据为表名在表2工作簿上插入一张新工作表（空表）。

青城山苦丁茶

Sub test()
Dim wk As Workbook
s$ = [b4]
Set wk = GetObject(ThisWorkbook.Path & "\表2.xls")
wk.Sheets.Add , wk.Worksheets(wk.Worksheets.Count)
wk.Worksheets(wk.Worksheets.Count).Name = s
wk.Save
wk.Close
Set wk = Nothing
End Sub

zsd5237

青城山苦丁茶 发表于 2011-11-13 10:28
Sub test()
Dim wk As Workbook
s$ =

模块代码可行，但如果将代码：wk.Close 注释后，代码运行时系统提示：运行时错误'91'   未设置对象或With block变量
请青城山苦丁茶老师再研究一下。

BAIXINGR

先学习下