在Excel中复制并粘贴嵌套的循环

我想通过表1中的8列（AH）循环，在表2中创build一个新列。然后再循环8列（IP），并在表2中创buildB列。我已经为大量数据做了这些工作，并且认为这将是最好的办法

这是我的代码

Range("E5").Select Range(Selection, Selection.End(xlDown)).Select Range("E5").Select Range(Selection, Selection.End(xlDown)).Select ActiveWindow.SmallScroll Down:=-96 Range("E5:E110").Select Selection.Copy Sheets("56 J").Select Range("A2").Select ActiveSheet.Paste Sheets("56 g").Select Range("F5").Select Range(Selection, Selection.End(xlDown)).Select Range("F5").Select Range(Selection, Selection.End(xlDown)).Select ActiveWindow.SmallScroll Down:=-96 Range("F5:F110").Select Selection.Copy Sheets("56 J").Select Range("A110").Select ActiveSheet.Paste Sheets("56 g").Select 

任何想法如何我可以把这个东西，通过列循环？

这是我正在做的事情的一个例子。我还想在循环的时候留下相应的数据。 但是我现在主要关注的只是将数据集中到一个列中。

Answer 1

你应该能够通过一些math循环遍历源列和目标列。

 Dim c As Long, n As Long, tws As Worksheet Set tws = Worksheets("56 j") With Worksheets("56 g") For n = 1 To 2 For c = 1 To 8 With .Range(.Cells(5, c + (n - 1) * 8), .Cells(.Rows.Count, c + (n - 1) * 8).End(xlUp)) tws.Cells(tws.Rows.Count, n).End(xlUp).Offset(1, 0).Resize(.Rows.Count, .Columns.Count) = .Value End With Next c Next n End With 

Answer 2

 Option Explicit Sub copydata() Dim WS1, WS2 As Worksheet Dim lastrow As Long Dim ws1Row, ws2Row As Long Dim mycol As Integer Set WS1 = Worksheets("sheet1") Set WS2 = Worksheets("sheet2") lastrow = WS1.Cells(WS1.Rows.Count, "A").End(xlUp).Row ws2Row = 2 For ws1Row = 5 To lastrow For mycol = 1 To 8 WS2.Cells(ws2Row, 1) = WS1.Cells(ws1Row, mycol) WS2.Cells(ws2Row, 2) = WS1.Cells(ws1Row, mycol + 8) ws2Row = ws2Row + 1 Next mycol Next ws1Row End Sub