Question

如果该行中有一个突出显示的单元格从一个工作簿到另一个工作簿，我试图复制整行。我现在看到这些值被放入目标工作簿中的不正确的单元格中。我无法找到有关如何放置信息的趋势。初始工作簿中的某些单元格可能会填写也可能不会填写，这很好，但我相信也许这可能是问题，因为我使用的是End（xlUp）。有什么提示吗？

基本上，如果单元格突出显示，我想将整行复制到另一个工作簿的不同列中。这是我的代码：

Sub Approval_Flow()
Dim AppFlowWkb As Workbook, ConfigWkb As Workbook
Dim AppFlowWkst As Worksheet, ConfigWkst As Worksheet
Dim aCell As Range, targetRng As Range


Set AppFlowWkb = Workbooks.Open("C:\Users\clara\Documents\Templates\FlowChangeLog.xlsx")
Set ConfigWkb = ThisWorkbook
Set AppFlowWkst = AppFlowWkb.Sheets("Editor")
Set ConfigWkst = ConfigWkb.Worksheets("Flows")


'looking through each column value before moving on to next row
For Each aCell In ConfigWkst.Range("A7:K" & ConfigWkst.UsedRange.Rows.Count)
    'if cell is highlighted, copy that row's column D value
    If Not aCell.Interior.Color = RGB(255, 255, 255) Then
        'requesting office
        Set targetRng = AppFlowWkst.Range("A" & Rows.Count).End(xlUp).Offset(1)
        targetRng.Value = ConfigWkst.Range("D" & (aCell.Row)).Value
        'type
        Set targetRng = AppFlowWkst.Range("B" & Rows.Count).End(xlUp).Offset(1)
        targetRng.Value = ConfigWkst.Range("C" & (aCell.Row)).Value
        '1
        Set targetRng = AppFlowWkst.Range("C" & Rows.Count).End(xlUp).Offset(1)
        targetRng.Value = ConfigWkst.Range("E" & (aCell.Row)).Value
        '2
        Set targetRng = AppFlowWkst.Range("E" & Rows.Count).End(xlUp).Offset(1)
        targetRng.Value = ConfigWkst.Range("F" & (aCell.Row)).Value
        '3
        Set targetRng = AppFlowWkst.Range("G" & Rows.Count).End(xlUp).Offset(1)
        targetRng.Value = ConfigWkst.Range("G" & (aCell.Row)).Value
        '4
        Set targetRng = AppFlowWkst.Range("I" & Rows.Count).End(xlUp).Offset(1)
        targetRng.Value = ConfigWkst.Range("H" & (aCell.Row)).Value
        '5
        Set targetRng = AppFlowWkst.Range("K" & Rows.Count).End(xlUp).Offset(1)
        targetRng.Value = ConfigWkst.Range("I" & (aCell.Row)).Value
        '6
        Set targetRng = AppFlowWkst.Range("M" & Rows.Count).End(xlUp).Offset(1)
        targetRng.Value = ConfigWkst.Range("J" & (aCell.Row)).Value
        '7
        Set targetRng = AppFlowWkst.Range("O" & Rows.Count).End(xlUp).Offset(1)
        targetRng.Value = ConfigWkst.Range("K" & (aCell.Row)).Value
    End If
Next aCell
AppFlowWkst.Range("A:S").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

End Sub

Answer 1

使用当前代码，来自相同源行的单元格可能会分散在不同的目标行上。您还要多次复制一些源行（当一行有许多突出显示的单元格时）。你需要的是：

1-只获取目标行一次并使用它然后在每次复制后递增它。该行应该是目标工作表中的“最后一个”非空行。您可以创建一个循环来查找最大值，但“轻量级”解决方案是使用UsedRange之后的第一行。

2-此外，您需要避免多次复制相同的源行。为此，您可以在迭代期间跟踪最后复制的源行。

' get the first target row once before starting the transfer
Dim targetRow as Long, lastCopiedRow as long
targetRow = AppFlowWkst.UsedRange.row + AppFlowWkst.UsedRange.Rows.Count

For Each aCell In ConfigWkst.Range("A7:K" & ConfigWkst.UsedRange.Rows.Count)
    If aCell.Interior.Color <> RGB(255, 255, 255) And aCell.row > lastCopiedRow Then
        ' office                                  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
        Set targetRng = AppFlowWkst.Range("A" & targetRow) 
        targetRng.Value = ConfigWkst.Range("D" & (aCell.Row)).Value
        'type
        Set targetRng = AppFlowWkst.Range("B" & targetRow)
        targetRng.Value = ConfigWkst.Range("C" & (aCell.Row)).Value

        ' ... etc

        targetRow = targetRow + 1 ' <-- Increment the target row after each transfer
        lastCopiedRow = aCell.Row ' <-- also save this to avoid recopying the same row
    End If
Next aCell

某些单元格没有从一个工作簿复制到目标工作簿

1 个答案: