[已解决]循环取数得到的第一列数据是乱的，第二第三列都缺少第一个sheet的数据是为什么？代...

陌雨落0724

Sub 复制数据()
Dim sht, irow&
Application.ScreenUpdating = False
Worksheets(1).Activate
  irow = Cells(Rows.Count, 1).End(xlUp).Row
  If irow > 1 Then irow = irow + 1
  For Each sht In Worksheets
   If sht.Name <> Worksheets(1).Name Then
    With sht
     .Range("a8:a8").Copy Range("a" & irow)
      irow = Cells(Rows.Count, 1).End(xlUp).Row + 1
     .Range("d6:d6").Copy Range("b" & irow)
      irow = Cells(Rows.Count, 1).End(xlUp).Row + 1
     .Range("e6:e6").Copy Range("c" & irow)
      irow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    End With
   End If
  Next
Application.ScreenUpdating = True
End Sub

最佳答案

月排行榜 / 总排行榜

chart888

2017-7-13 17:34

1. Private Sub CommandButton1_Click()
   
2. Dim sht, irow&
   
3. Application.ScreenUpdating = False
   
4. Worksheets(1).Activate
   
5.     irow = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
   
6.     If irow > 1 Then irow = irow + 1
   
7.     For Each sht In Worksheets
   
8.         If sht.Name <> Worksheets(1).Name Then
   
9.             With sht
   
10.                 irow = irow + 1
    
11.                 .Range("a8:a8").Copy Range("a" & irow)
    
12.                 .Range("d6:d6").Copy Range("b" & irow)
    
13.                 .Range("e6:e6").Copy Range("c" & irow)
    
14.             End With
    
15.         End If
    
16.     Next
    
17. Application.ScreenUpdating = True
    
18. End Sub

复制代码

跳转到最佳答案楼层

chart888

1. Private Sub CommandButton1_Click()
   
2. Dim sht, irow&
   
3. Application.ScreenUpdating = False
   
4. Worksheets(1).Activate
   
5.     irow = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
   
6.     If irow > 1 Then irow = irow + 1
   
7.     For Each sht In Worksheets
   
8.         If sht.Name <> Worksheets(1).Name Then
   
9.             With sht
   
10.                 irow = irow + 1
    
11.                 .Range("a8:a8").Copy Range("a" & irow)
    
12.                 .Range("d6:d6").Copy Range("b" & irow)
    
13.                 .Range("e6:e6").Copy Range("c" & irow)
    
14.             End With
    
15.         End If
    
16.     Next
    
17. Application.ScreenUpdating = True
    
18. End Sub

复制代码

陌雨落0724

chart888 发表于 2017-7-13 17:34

您好，我还有几个问题想咨询，可以加您QQ好友咨询吗？

chart888

陌雨落0724 发表于 2017-7-14 10:59
您好，我还有几个问题想咨询，可以加您QQ好友咨询吗？

可以