在 Excel 中复制多个单元格答案

【问题标题】：Copying multiple cells in Excel在 Excel 中复制多个单元格
【发布时间】：2018-03-28 00:17:16
【问题描述】：

我是新手，但我正在尝试复制 Excel 工作簿中的多个单元格并将它们粘贴到同一工作簿的单独选项卡中。

以上是我的电子表格的示例，但我的电子表格有超过 800 行数据。

我需要将姓名复制并放入 Sheet2 的 A 列，然后将帐号放入 Sheet2 的 D 列。

我已经尝试了这两种不同的方法。

使用以下代码：

Sheets("Sheet1").Select
Range("A1,A3,A5,A7,A9").Select    
Range("A10").Activate
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("A2,A4,A6,A8,A10").Select    
Range("A10").Activate
Selection.Copy
Sheets("Sheet2").Select
Range("D1").Select
ActiveSheet.Paste

这给了我一个Compile Error Syntax Error。

代码 #2
```
Range("A2").Select
Selection.Cut
Range("D1").Select
ActiveSheet.Paste
Range("A4").Select
Selection.Cut
Range("D3").Select
ActiveSheet.Paste
...
```
这是将它们保留在同一个选项卡中，而不是将它们粘贴到单独的选项卡中（我稍后会复制它们）。我为每个客户重复这一点。这给了我一个范围错误，基本上说它太大了。不幸的是，我无法重新创建它，因为我删除了它。

有没有人有更简单的方法来做到这一点，不会导致错误？

【问题讨论】：

标签： vba excel

【解决方案1】：

假设您的数据一直在交替（姓名、帐户），请尝试这样做。

Sub marine()
    Dim lr As Long, i As Long
    Dim sh1 As Worksheet, sh2 As Worksheet
    '/* declare the worksheets and use variables in the rest of the code */
    Set sh1 = Sheets("Sheet1"): Set sh2 = Sheets("Sheet2")

    With sh1
        lr = .Range("A" & .Rows.Count).End(xlUp).Row '/* get the last row in Sheet1 */
        For i = 1 To lr '/* loop to all rows identified */
            If i Mod 2 = 1 Then '/* check if odd or even, copy in A if odd */
                .Range("A" & i).Copy _
                sh2.Range("A" & sh2.Rows.Count).End(xlUp).Offset(1, 0)
            Else '/* copy in D otherwise */
                .Range("A" & i).Copy _
                sh2.Range("D" & sh2.Rows.Count).End(xlUp).Offset(1, 0)
            End If
        Next
    End With
End Sub

Above 将数据从 Sheet1 复制到 Sheet2，但第一行留空。
此外，它总是在 Sheet2（A 和 D）中每列的最后一行复制数据。
所以另一种方法是：

Sub ject()
    Dim lr As Long, i As Long, lr2 As Long
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim rNames As Range, rAcct As Range
    Set sh1 = Sheets("Sheet1"): Set sh2 = Sheets("Sheet2")

    With sh1
        lr = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 1 To lr
            If i Mod 2 = 1 Then
                If rNames Is Nothing Then '/* get all the cells with names */
                    Set rNames = .Range("A" & i)
                Else
                    Set rNames = Union(rNames, .Range("A" & i))
                End If
            Else
                If rAcct Is Nothing Then '/* get all the cells with accounts */
                    Set rAcct = .Range("A" & i)
                Else
                    Set rAcct = Union(rAcct, .Range("A" & i))
                End If
            End If
        Next
    End With

    With sh2
        '/* get the last filled Names column in Sheet2 */
        lr2 = .Range("A" & .Rows.Count).End(xlUp).Row
        rNames.Copy .Range("A" & lr2) '/* execute 1 time copy */
        rAcct.Copy .Range("D" & lr2) '/* execute 1 time copy */
    End With
End Sub

上面的代码确保正确的帐户与正确的名称相邻。
由于执行一 (1) 次复制，您也可能获得执行性能。 HTH。

P.S.尽可能avoid using Select。

【讨论】：

【解决方案2】：

我实现的逻辑是在第 2 步中循环直到 Sheet1 中的最后一行。循环变量始终指示带有名称的行，下一行是帐号，因此很容易在循环中将这些值分配给特定列另一张纸。另外，我使用了另一个变量j，它表示Sheet2中的连续行。

解决方案：

Sub CopyData()

Dim sourceWs As Worksheet, targetWs As Worksheet, i As Long, lastRow As Long, j As Long
j = 1
Set sourceWs = Worksheets("Sheet1")
Set targetWs = Worksheets("Sheet2")
lastRow = sourceWs.Cells(sourceWs.Rows.Count, 1).End(xlUp).Row

For i = 1 To lastRow Step 2
    targetWs.Cells(j, 1) = sourceWs.Cells(i, 1)
    targetWs.Cells(j, 4) = sourceWs.Cells(i + 1, 1)
    j = j + 1
Next

End Sub

【讨论】：