VB函数调用其他表格数据，最后会出现两个空列。

＄雷锋King￥

用下面的VB代码调用数据，最后莫名其妙多出来2列空行，而且导致了数据错位。哪位帮忙看下。？？
谢谢了


Sub shuaxin()
Dim ws As Workbook, sht As Worksheet
Dim arr, brr, d, path$, i&, k&, str
Application.ScreenUpdating = False
Set sht = ActiveSheet
path = ThisWorkbook.path & "\源数据" & "\"
d = Dir(path & "*.xls")
sht.Cells.ClearContents
[a1:o1] = Array("关键词", "平均搜索排名", "曝光量", "点击次数", "点击率", "浏览量", "访客数", "人均浏览量", "跳失率", "支付买家数", "支付商品件数", "支付金额", "支付转化率", "日期", "渠道", "", "")
    Do While d <> ""
        Set ws = Workbooks.Open(path & d)
        str = Left(Right(ws.Name, 14), 10)
        std = Left(ws.Name, 10)
        With ActiveSheet
            arr = .Range("A6:Z" & .Cells(Rows.Count, 1).End(3).Row)
        End With
            ReDim brr(1 To UBound(arr), 1 To 29)
            For i = 1 To UBound(arr)
                brr(i, 1) = arr(i, 1): brr(i, 2) = arr(i, 2)
                brr(i, 3) = arr(i, 3): brr(i, 4) = arr(i, 4)
                brr(i, 5) = arr(i, 5): brr(i, 6) = arr(i, 6)
                brr(i, 7) = arr(i, 7): brr(i, 8) = arr(i, 8)
                brr(i, 9) = arr(i, 9): brr(i, 10) = arr(i, 10)
                brr(i, 11) = arr(i, 11): brr(i, 12) = arr(i, 12)
                brr(i, 13) = arr(i, 13): brr(i, 14) = arr(i, 14)
                brr(i, 15) = arr(i, 15): brr(i, 16) = str
                brr(i, 17) = std
            Next
        With sht
          k = .Cells(Rows.Count, 1).End(3).Row + 1
        .Cells(k, 1).Resize(UBound(brr), 20) = brr
        End With
        ws.Close False
        d = Dir
    Loop
Application.ScreenUpdating = True
End Sub

abc123281

那你的附件呢

lsc900707

到底需要多少列呢，表头15列，数据17列，brr声明29列，最后又是resize20列，l乱七八糟的。附件也不传。

＄雷锋King￥

abc123281 发表于 2018-10-3 12:18
那你的附件呢

不好意思，附件已经更新。

＄雷锋King￥

lsc900707 发表于 2018-10-3 15:07
到底需要多少列呢，表头15列，数据17列，brr声明29列，最后又是resize20列，l乱七八糟的。附件也不传。

不好意思，附件已经更新。

lsc900707

＄雷锋King￥ 发表于 2018-10-3 19:11
不好意思，附件已经更新。

Sub shuaxin()
    Dim brr(1 To 99999, 1 To 15)
    Application.ScreenUpdating = False
    Set sht = ActiveSheet
    path = ThisWorkbook.path & "\源数据\"
    d = Dir(path & "*.xls")
    Do While d <> ""
        Set ws = Workbooks.Open(path & d)
        With ws.Sheets(1)
            arr = .UsedRange
        End With
        For i = 6 To UBound(arr)
            If Len(arr(i, 1)) Then
                m = m + 1
                For j = 1 To 13
                    brr(m, j) = arr(i, j)
                Next
                brr(m, 14) = Left(Right(ws.Name, 14), 10)
                brr(m, 15) = Left(ws.Name, 10)
            End If
         Next
        ws.Close False
        d = Dir
    Loop
    If m Then
        With sht
             .Cells.ClearContents
             .[a1:m1] = Array("关键词", "平均搜索排名", "曝光量", "点击次数", "点击率", "浏览量", "访客数", "人均浏览量", "跳失率", "支付买家数", "支付商品件数", "支付金额", "支付转化率")
             .[a2].Resize(m, 15) = brr
        End With
    End If
    Application.ScreenUpdating = True
End Sub

lsc900707

＄雷锋King￥ 发表于 2018-10-3 19:11
不好意思，附件已经更新。

代码需要审核，先测试附件吧。

＄雷锋King￥

lsc900707 发表于 2018-10-3 21:09
代码需要审核，先测试附件吧。

太感谢了。搞定了