相同区域复制

fsd369

”啊“表中有多个相同区域，需将相同区域的内容转到"啊转置"里面，最开始只有一个"啊“表在工作簿里面。

Sub 转置()
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer

    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "啊转置"
For a = 4 To 1300 Step 74
For b = 72 To 1300 Step 74
For c = 4 To 1300 Step 14
Sheets("啊").Range(Cells(a, 4), Cells(b, 14)).Copy
Sheets("啊转置").Range("D4").Select
  Sheets("啊转置").Range("D4").Paste
Next a, b, c


'Sheets("上行").Range(Cells(a, 4), Cells(b, 14)).Copy

End Sub

liulang0808

Sheets("啊").Range(Sheets("啊").Cells(a, 4), Sheets("啊").Cells(b, 14)).Copy

fsd369

liulang0808 发表于 2019-12-8 11:24
Sheets("啊").Range(Sheets("啊").Cells(a, 4), Sheets("啊").Cells(b, 14)).Copy

Sub 转置()
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer

    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "啊转置"
For a = 4 To 1400 Step 74
For b = 72 To 1400 Step 74
For c = 4 To 1400 Step 14
Sheets("啊").Range(Sheets("啊").Cells(a, 4), Sheets("啊").Cells(b, 14)).Copy
Sheets("啊转置").Range(Sheets("啊转置").Cells(c, 4), Sheets("啊转置").Cells(72, 14 + c)).Select
Sheets("啊转置").Range(Sheets("啊转置").Cells(c, 4), Sheets("啊转置").Cells(72, 14 + c)).Paste
Next a, b, c
If c = 1400 Then
Exit Sub
End If

End Sub



提示无效的NEXT

fsd369

还有，使用数组怎么解决呢？

fsd369

为什么还是不行呢

Sub Macro1()
Dim a As Integer
Dim b As Integer
Dim c As Integer
For a = 4 To 1400 Step 74
For b = 72 To 1400 Step 74
For c = 4 To 1400 Step 14
Sheets("啊").Range(Sheets("啊").Cells(a, 4), Sheets("啊").Cells(b, 14)).Select
Selection.Copy


    Sheets("啊转置").Select
    Sheets("啊转置").Range(Sheets("啊转置").Cells(2, c), Sheets("啊转置").Cells(72, 14 + c)).Select
    ActiveSheet.Paste
Next
Next
Next
End Sub

liulang0808

1. Sub 转置()
   
2. Dim a As Integer
   
3. Dim b As Integer
   
4. Dim c As Integer
   
5. Dim d As Integer
   
6. 
   
7. 'c = InputBox("输入单体行数：")
   
8. 'd = InputBox("输入单体最后列数：")
   
9.     Sheets.Add After:=Sheets(Sheets.Count)
   
10.     ActiveSheet.Name = "啊转置"
    
11. For a = 4 To 1300 Step 74
    
12. For b = 72 To 1300 Step 74
    
13. For c = 4 To 1300 Step 14
    
14. Sheets("啊").Range(Sheets("啊").Cells(a, 4), Sheets("啊").Cells(b, 14)).Copy Sheets("啊转置").Range("D4")
    
15. Next c
    
16. Next b
    
17. Next a
    
18. 
    
19. 
    
20. 
    
21. 
    
22. End Sub

复制代码

以上代码可以运行，但是楼主这种频繁拷贝，针对另一张的一个位置拷贝，不知道有什么意义的

大灰狼1976

1. Sub test()
   
2. Dim a As Integer
   
3. Dim c As Integer
   
4. 
   
5. Sheets.Add After:=Sheets(Sheets.Count)
   
6. ActiveSheet.Name = "啊转置"
   
7. c = 1
   
8. For a = 4 To 1300 Step 74
   
9.   Sheets("啊").Cells(a, 4).Resize(69, 14).Copy Sheets("啊转置").Cells(2, c)
   
10.   c = c + 14
    
11. Next a
    
12. 
    
13. End Sub

复制代码

fsd369

感谢各位，主要是原表都是竖的 要转横排才能用