Question

我回来了！因此，当单元格说“是”时，只要按一下按钮，我就将数据行从一个电子表格复制到另一个电子表格，并删除原始数据行。我要从同一行复制多个范围，因为第二个电子表格不需要第一个电子表格中保存的所有数据。（第一个电子表格具有超过20列的数据，而第二个电子表格具有一半的数据）。有没有一种简单的方法来确保将所有内容复制到新电子表格的同一行中？

基本上，我目前正在将每个范围复制到新电子表格中的相应列，并将行号设置为上次使用的行偏移量设置为1。如果以前的单元格中实际包含数据，则可以正常工作，但有时却没有（数据是关于家庭的，有些数据比其他数据多，因此并非总是填充所有列），因此该数据与该特定家庭的其余数据放在不同的行中。

Private Sub CommandButton1_Click()

Dim c As Range
Dim r As Integer
Dim LastRowD
Dim LastRowR
Dim Database As Worksheet
Dim DeReg As Worksheet


    'Set worksheet deignation as needed
    Set Database = ActiveWorkbook.Worksheets("Fostering Households")
    Set DeReg = ActiveWorkbook.Worksheets("De-Registrations")

    LastRowD = Database.Cells(Database.Rows.Count, "A").End(xlUp).Row

    'Searches all rows in I
    For Each c In Database.Range("I1:I" & LastRowD)

        'Catches cases where "Yes" is present in column I
        If c = "Yes" Then

            LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0)
            r = c.Row

            'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab
            Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            Database.Range("H" & r).Copy DeReg.Range("AJ" & Rows.Count).End(xlUp).Offset(1, 0)
            Database.Range("J" & r & ":X" & r).Copy DeReg.Range("H" & Rows.Count).End(xlUp).Offset(1, 0)
            Database.Range("AN" & r).Copy DeReg.Range("W" & Rows.Count).End(xlUp).Offset(1, 0)
            Database.Range("AS" & r).Copy DeReg.Range("X" & Rows.Count).End(xlUp).Offset(1, 0)
            Database.Range("AZ" & r & ":BH" & r).Copy DeReg.Range("Y" & Rows.Count).End(xlUp).Offset(1, 0)

        End If


    Next c

    For i = 250 To 1 Step -1

        If Database.Range("I" & i) = "Yes" Then
            Database.Rows(i).EntireRow.Delete
        End If

    Next i



End Sub

我尝试根据以下代码定义“ A”是否有数据（这是始终使用的唯一单元格），最后一行：

LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0)，然后将我过去的复制代码替换为：

Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR & ":B" & LastRowR).Row

但是这根本不起作用-它无限复制了找到的第一行，并以“是”复制了已经存在的所有数据。我也尝试过：

Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR).PasteSpecial

也伴随着很多问题和错误。我想要的是基于A列中的内容搜索上一次使用的行，将其偏移1，然后将数据粘贴到我指定的列中，而不是我尝试粘贴的列中定义的最后一行在-这甚至可行吗？我似乎找不到有关此特定问题的任何信息。另外，如果有更好的方式处理多个范围，那将是很好的选择，因为目前看来这很复杂！谢谢<3

Answer 1

DeReg.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)的计算结果为：

DeReg.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Offset(1, 0)，因此，除非DeReg是活动表，否则您将获得错误的范围。

看看是否有帮助：

.... other code
'LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0)
r = c.Row

'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab

    With Database
        LastRowR = DeReg.Range("A" & DeReg.Rows.Count).End(xlUp).Row + 1

        .Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR)
        .Range("H" & r).Copy DeReg.Range("AJ" & LastRowR)
        .Range("J" & r & ":X" & r).Copy DeReg.Range("H" & LastRowR)
        .Range("AN" & r).Copy DeReg.Range("W" & LastRowR)
        .Range("AS" & r).Copy DeReg.Range("X" & LastRowR)
        .Range("AZ" & r & ":BH" & r).Copy DeReg.Range("Y" & LastRowR)
    End With

End If
... other code

Answer 2

一些有用的提示：

i未声明。声明为Long。
LastRowR，r和LastRowD应该声明为Long。
将ActiveWorkbook替换为ThisWorkbook。
使用的复制粘贴方法可能会减慢程序的速度，因为此方法会复制并粘贴值和格式。
要粘贴到最后一行之后的行中，请使用+1（例如：LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row +1

Answer 3

只是几个想法。首先，您已经声明了许多不必要的东西（IMO）。我已经调整了for循环，使其简单地循环通过一个值，然后该值引用了您想要的范围。这样，您可以比先设置一个范围然后遍历并引用该行等更有效地使用i值。

此外，根据我对您的帖子的理解，如果您使用.UsedRanged方法，则无论您以前按列选择哪种方法，输出都将从新工作表的最后一行开始。我尚未测试以下代码，但是它应该可以更清晰地指导您。

Option Explicit

Private Sub CommandButton1_Click()

Dim i As Long
Dim LastRowD As Long
Dim LastRowR As Long
Dim Database As Worksheet
Dim DeReg As Worksheet

'Set worksheet deignation as needed
Set Database = ActiveWorkbook.Worksheets("Fostering Households")
Set DeReg = ActiveWorkbook.Worksheets("De-Registrations")

LastRowD = Database.Cells(Database.Rows.Count, "A").End(xlUp).Row

'Searches all rows in I
For i = 1 To LastRowD
    'Catches cases where "Yes" is present in column I
    If Database.Range("I" & i) = "Yes" Then

        LastRowR = Database.UsedRange.Rows.Count + 1

        'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab
        Database.Range("A" & i & ":G" & i).Copy DeReg.Range("A" & LastRowR)
        Database.Range("H" & i).Copy DeReg.Range("AJ" & LastRowR)
        Database.Range("J" & i & ":X" & i).Copy DeReg.Range("H" & LastRowR)
        Database.Range("AN" & i).Copy DeReg.Range("W" & LastRowR)
        Database.Range("AS" & i).Copy DeReg.Range("X" & LastRowR)
        Database.Range("AZ" & i & ":BH" & i).Copy DeReg.Range("Y" & LastRowR)

    End If

Next i

For i = 250 To 1 Step -1

    If Database.Range("I" & i) = "Yes" Then
        Database.Rows(i).EntireRow.Delete
    End If

Next i

End Sub

将多个范围复制到下一个可用行

3 个答案: