求大侠编个vba把每天book1中sheet1的数据接到到book2的sheet1的表中

jokuke

列子如下 book.rar (6.65 KB, 下载次数: 83)

2013-12-22 21:35 上传

点击文件名下载附件

jokuke

朱荣兴 发表于 2013-12-22 21:59
总是把简单问题复杂化，为何要跨工作薄呢，

book1是别人做的

jokuke

那位大侠帮下忙

ychgczq

Sub a()
    Dim arr, arr1(1 To 65536, 1 To 9)
    arr = Range("b5:j" & Range("a65536").End(xlUp).Row)
    s = Range("j3")
    For x = 1 To UBound(arr)
        If arr(x, 1) <> "" Then
            k = k + 1
            arr1(k, 1) = Format(Now(), "yyyy-mm-dd")
            arr1(k, 2) = s
            arr1(k, 3) = arr(x, 7)
            arr1(k, 4) = arr(x, 9)
            arr1(k, 5) = arr(x, 1)
            arr1(k, 6) = arr(x, 2)
            arr1(k, 7) = arr(x, 4)
            arr1(k, 8) = arr(x, 5)
            arr1(k, 9) = arr(x, 6)
        End If
    Next
    Filename = Dir(ThisWorkbook.Path & "\Book2.xls")
  '  Do While Filename <> ""
        Workbooks.Open ThisWorkbook.Path & "\" & Filename
        ActiveWorkbook.Sheets(1).Range("a65536").End(xlUp).Offset(1, 0).Resize(k, 9) = arr1
        ActiveWorkbook.Close True
       ' Filename = Dir
  '  Loop

End Sub