根据工作表名是否相同录入数据

仙人不留果

麻烦大家了，琢磨了几天还是不会，
请大家帮帮忙，谢谢！！！

chis3

我說這個非常容易
但我想提一提醒你,你的思想可以放寬一點
那個單號可以整列每一行也相同單號
不要只在頭放一個單行,那麼循環便很容易了

仙人不留果

chis3 发表于 2018-3-28 21:04
我說這個非常容易
但我想提一提醒你,你的思想可以放寬一點
那個單號可以整列每一行也相同單號

谢谢大佬指教，真的不懂呀，发票那个也是论坛里面找来一点一点改好的，拜托了，谢谢！！！

仙人不留果

朱荣兴 发表于 2018-3-28 21:05
全是英文，看不懂，

求老大看看，谢谢，真的不知道怎么做

chis3

Sub test()
    Application.ScreenUpdating = False
    Dim arr, i As Byte, j As Integer, brr(), counter As Byte, k As Byte
    arr = Range(Range("t1"), Cells(Rows.Count, "x").End(xlUp))
    For i = 3 To Sheets.Count
        Sheets(i).Activate
        For j = 1 To UBound(arr)
            If Sheets(i).Name = Val(arr(j, 1)) Then
                counter = counter + 1
                ReDim Preserve brr(1 To 5, 1 To counter)
                For k = 1 To 5
                    brr(k, counter) = arr(j, k)
                Next k
            End If
        Next j
        [a1].Resize(counter, 5) = Application.Transpose(brr)
        counter = 0
        Erase brr
    Next i
    Application.ScreenUpdating = True
End Sub

仙人不留果

chis3 发表于 2018-3-28 21:35
Sub test()
    Application.ScreenUpdating = False
    Dim arr, i As Byte, j As Integer, brr(), cou ...

谢谢老师，在家试了确实好用，
有个疑问，如果单号中间有空行，就会中断，这个怎么改呀