VBA代码如何写：两文件夹，对应的两个工作薄的，对应位置的 ，复制制粘贴，循环操作。

【求助帖】请及时确认最佳答案，下次提问时可以得到更多关注，问题可以更快解决

文件夹1（含18个excel工作薄，薄名分别含关键字“1-18”数字，如“上海1，北京2小明，3广东小红”（命名无规则）），文件夹2 （同样含18个excel工作薄，薄名分别含关键字“1-18”的数字，命名除关键字外无规则）。

问题： 把【文件夹1中，薄名含“1”，sheet1.range("A1") 】 中的数值 ，复制 到    【文件夹2，薄名含“1”，sheet1.range("A1") 】  中； 用循环，依次，把 薄名含“2、3、4、……18”的对应，复制粘贴。


求代码！！！！！

谢谢各位大神

爱疯

Dim reg As Object
Sub test()
    Dim arr$(1 To 18, 1 To 2), sPath$, dPath$, i%, tmp$
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    sPath = "d:\3"    '源
    dPath = "d:\4"    '目的
    Set reg = CreateObject("vbscript.regexp")
    Call createArray(arr, sPath, 1)
    Call createArray(arr, dPath, 2)
    For i = 1 To UBound(arr)
        If arr(i, 1) = "" Then Exit For
        Workbooks.Open sPath & "\" & arr(i, 1)
        tmp = Sheets("sheet1").Range("a1")
        ActiveWorkbook.Close
        Workbooks.Open dPath & "\" & arr(i, 2)
        Sheets("sheet1").Range("a1") = tmp
        ActiveWorkbook.Close True
    Next i
End Sub

'建立数组：第1维是源，第2维是目的
Sub createArray(arr, path$, c%)
    Dim file As String
    file = Dir(path & "\*")
    Do While file <> ""
        arr(strToInt(file), c) = file
        file = Dir
    Loop
End Sub

'字符串转数字
Function strToInt(str As String) As Integer
    With reg
        .Global = True
        .Pattern = "\D"
        strToInt = .Replace(str, "")
    End With
End Function
两文件夹.rar (10.69 KB, 下载次数: 3)

2014-11-10 10:11 上传

点击文件名下载附件



没做什么检查，执行时，替换你的地址