[已解决]EXCEL VBA批量复制

福瑞安

分别将各表名称的数字编号(如2012-007-XX)批量复制到各表sheet1的K6单元格内!!谢谢!

最佳答案

月排行榜 / 总排行榜

hrpotter

2012-8-11 22:01

福瑞安 发表于 2012-8-11 21:28
Sub test()
    Dim f As String
    Dim reg As Object

1.     wb.Sheets("数据录入").Range("k6") = .Execute(wb.Name)(0)

复制代码

跳转到最佳答案楼层

hrpotter

在源数据表的目录下新建工作簿，把下面的代码拷到新工作簿中，运行一遍就行了

1. Sub test()
   
2.     Dim f As String
   
3.     Dim reg As Object
   
4.     Dim wb As Workbook
   
5.     Application.ScreenUpdating = False
   
6.     Set reg = CreateObject("vbscript.regexp")
   
7.     With reg
   
8.         .Global = True
   
9.         .Pattern = "\d+-\d+-\d+"
   
10.         f = Dir(ThisWorkbook.Path & "\*.xls")
    
11.         Do While Len(f) > 0
    
12.             If f <> ThisWorkbook.Name Then
    
13.                 Set wb = Workbooks.Open(ThisWorkbook.Path & "" & f)
    
14.                 wb.Sheets(1).Range("k6") = .Execute(wb.Name)(0)
    
15.                 wb.Close True
    
16.             End If
    
17.             f = Dir
    
18.         Loop
    
19.     End With
    
20.     Set wb = Nothing
    
21.     Application.ScreenUpdating = True
    
22. End Sub

复制代码

福瑞安

hrpotter 发表于 2012-8-11 20:01
在源数据表的目录下新建工作簿，把下面的代码拷到新工作簿中，运行一遍就行了

Sub test()
    Dim f As String
    Dim reg As Object
    Dim wb As Workbook
    Application.ScreenUpdating = False
    Set reg = CreateObject("vbscript.regexp")
    With reg
        .Global = True
        .Pattern = "\d+-\d+-\d+"
        f = Dir(ThisWorkbook.Path & "\*.xls")
        Do While Len(f) > 0
            If f <> ThisWorkbook.Name Then
                Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f)
                wb.数据录入.Range("k6") = .Execute(wb.数据录入)(0)
                wb.Close True
            End If
            f = Dir
        Loop
    End With
    Set wb = Nothing
    Application.ScreenUpdating = True
End Sub

请问把SHEET1改成数据录入怎么就运行不了!

zhangkui2130

                           

hrpotter

福瑞安 发表于 2012-8-11 21:28
Sub test()
    Dim f As String
    Dim reg As Object

1.     wb.Sheets("数据录入").Range("k6") = .Execute(wb.Name)(0)

复制代码

福瑞安

hrpotter 发表于 2012-8-11 22:01

行了,非常感谢!!!!

wzq47111

很好的代码，谢谢