工作簿信息提取汇总。

肉肉瘦瘦瘦

请教大神将人员信息表内内容自动生成到信息汇总表里，感激不尽。

肉肉瘦瘦瘦

按照论坛里的程序，编写了，但是不知道哪里错了，总运行不了~忧桑~

肉肉瘦瘦瘦

Sub mergeSheet()
Dim i, j As Integer
Dim arr As Variant
Dim count As Integer
Dim newData As Variant
Dim maxNon As Integer

Sheets("人员信息表").Range("B3:Q500").ClearContents
For i = 1 To Worksheets.count
   If Sheets(i).Name <> "人员信息表" Then
      With Sheets(i)
         maxR = .Range("A" & .Rows.count).End(xlUp).Row
         arr = .Range("A2:G" & maxR).Value
'         For j = 1 To UBound(arr, 1)
          newData = Array(arr(2, 2), arr(2, 5), arr(3, 2), arr(2, 7), arr(3, 5), arr(3, 7), _
          arr(5, 2), arr(5, 7), arr(4, 2), arr(7, 2), arr(7, 7), arr(6, 2), arr(6, 5), arr(6, 7), arr(4, 6))
          With Sheets("人员信息表")
            maxNon = .Range("B" & .Rows.count).End(xlUp).Row
            .Range("B" & (maxNon + 1)).Resize(1, UBound(newData) + 1) = newData
          End With
'         Next j
      End With
   
   End If
Next

End Sub

LMY123

肉肉瘦瘦瘦 发表于 2018-6-22 11:38
Sub mergeSheet()
Dim i, j As Integer
Dim arr As Variant

1. <blockquote>Sub mergeSheet()

复制代码

LMY123

肉肉瘦瘦瘦 发表于 2018-6-22 11:38
Sub mergeSheet()
Dim i, j As Integer
Dim arr As Variant

1. Sub mergeSheet()
   
2. Dim i, j As Integer
   
3. Dim arr As Variant
   
4. Dim count As Integer
   
5. Dim newData As Variant
   
6. Dim maxNon As Integer
   
7. 
   
8. Sheets("信息汇总表").Range("B3:Q500").ClearContents
   
9. For i = 1 To Worksheets.count
   
10.    If Sheets(i).Name <> "信息汇总表" Then
    
11.       With Sheets(i)
    
12.          maxR = .Range("A" & .Rows.count).End(xlUp).Row
    
13.          arr = .Range("A2:G" & maxR).Value
    
14. '         For j = 1 To UBound(arr, 1)
    
15.           newData = Array(arr(2, 2), arr(2, 5), arr(3, 2), arr(2, 7), arr(3, 5), arr(3, 7), _
    
16.           arr(5, 2), arr(5, 7), arr(4, 2), arr(7, 2), arr(7, 7), arr(6, 2), arr(6, 5), arr(6, 7), arr(4, 6))
    
17.           With Sheets("信息汇总表")
    
18.             maxNon = .Range("B" & .Rows.count).End(xlUp).Row
    
19.             .Range("B" & (maxNon + 1)).Resize(1, UBound(newData) + 1) = newData
    
20.           End With
    
21. '         Next j
    
22.       End With
    
23.    
    
24.    End If
    
25. Next
    
26. 
    
27. End Sub

复制代码

abc123281

要求不明白  你是要汇总  还是要保存  如果是汇总  后面应该有多个人的信息表

肉肉瘦瘦瘦

LMY123 发表于 2018-6-22 11:45

谢谢您，刚刚试了您的程序，有些信息对应不上~是newdate这行吗~

LMY123

肉肉瘦瘦瘦 发表于 2018-6-22 11:53
谢谢您，刚刚试了您的程序，有些信息对应不上~是newdate这行吗~

arr = .Range("A1:G" & maxR).Value