从excel表复制几行，并粘贴到新excel表的同一行

Question

谁能提供一些VBA代码请，这将有助于以下请求?

我想复制六行，并将它们粘贴到同一行的新工作表中。我有数百行，因此需要代码。它需要将前六行复制到一行，将后六行复制到第二行，以此类推。如下例所示，要复制的每一行有9个单元格。

ColA            |ColB           |ColC|ColD|ColE|ColF|ColG|ColH|ColI
Separatecombined|Smoothedremoved|1.00|1.00|99  |90  |95  |98  |accuracy

许多谢谢。

安迪

Answer 1

这个网站的存在是为了让程序员能够帮助其他程序员提高他们的技能。有时答案中会提供重要的代码片段，但这不是一个免费的编码网站。

执行您需要的操作的宏是如此的小和简单，我不相信你知道任何VBA。通常情况下，我会通过告诉您如何编写您所寻找的宏来回答此类问题。但是，您的需求非常简单，编写代码比提供说明更容易。如果你想使用宏，你必须学习VBA。学习基本知识不会花很长时间，花的时间很快就会得到回报。搜索"VBA Excel教程"。有很多选择。尝试几个，然后完成一个符合你学习风格的。我更喜欢读书。我参观了一个大图书馆，复习了所有的Excel VBA入门。然后我买了我喜欢的那个。

第一个任务是查找源工作表中最后使用的行。我用的是通常最方便的方法。然而，有几种方法可以找到最后一行或最后一列，但没有一种方法适用于每种情况。我选择的方法可能不适用于您的数据。我的答案包括一个宏，FindFinal，它使用各种方法并显示它们失败的时间。这将帮助您在必要时选择替代方案。

然后需要嵌套的for循环来移动数据。

下面的宏是你要求的，但我不确定它是你想要的宏。如果我有您的要求，我希望源第一行(列标题)复制六次，然后复制第2行到最后一行。我留给您的任务是创建我的内循环的副本，以实现这种复制。如果有必要，你可以带着问题回来，但我相信强迫你做这个修改会帮助你理解我的代码，并帮助你发展自己的技能。

祝你好运，欢迎享受编程的乐趣。

Option Explicit
Sub MergeRows()
   Dim ColDestCrnt As Long
   Dim RowDestCrnt As Long
   Dim RowSrcCrnt As Long
   Dim RowSrcLast As Long
   Dim RowWithinGroupNum As Long
   Dim WshtDest As Worksheet
   Application.ScreenUpdating = False
   Set WshtDest = Worksheets("Destination")
   With Worksheets("Source")
     ' Find last used row of worksheet.  This assumes column "A"
     ' contains a value in every used row.
     RowSrcLast = .Cells(Rows.Count, "A").End(xlUp).Row
     RowDestCrnt = 1
     ' Loop for each set of six rows.  Unless the source worksheet
     ' contains a multiple of six rows, the last set will involve the
     ' copying of empty rows.  I decided it was less effort to copy
     ' these empty rows than to include code to not copy them
     For RowSrcCrnt = 1 To RowSrcLast Step 6
       ' Loop for each row within a set
       For RowWithinGroupNum = 0 To 5
         ' Calculate the start column in the destination worksheet
         ColDestCrnt = (RowWithinGroupNum) * 6 + 1
         ' Copy all six cells from the current source row to the six cells
         ' starting at the appropriate column in the destination row
         .Range(.Cells(RowSrcCrnt + RowWithinGroupNum, 1), _
                .Cells(RowSrcCrnt + RowWithinGroupNum, 6)).Copy _
                      Destination:=WshtDest.Cells(RowDestCrnt, ColDestCrnt)
       Next RowWithinGroupNum
       ' Step the destination row ready for the next set
       RowDestCrnt = RowDestCrnt + 1
     Next RowSrcCrnt
   End With
End Sub