Question

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

Example:

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

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

我尝试了这2种不同的方式。

使用以下代码：

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
...
```
这是将它们保存在同一个标签中，而不是将它们粘贴到一个单独的标签中（我稍后会复制它们）。我为每个客户重复一遍。这个给我一个范围错误，基本上说它太大了。不幸的是，我无法重新创建它，因为我删除了它。

有没有人有更简单的方法来做这个不会导致错误？

Answer 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

上面将数据从 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。

Answer 2

我实现的逻辑是循环到Sheet1中步骤2中的最后一行。循环变量总是指示带有名称的行，后面的行是帐号，所以在循环中很容易将这些值分配给特定的另一张纸上的列。另外，我使用了另一个变量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

在Excel

2 个答案: