首页 > 解决方案 > 从 Col B 不为空的同一行下复制第三个单元格

问题描述

我一直在尝试创建一个函数来检查如果 Col"B" <> Empty 然后复制同一行下的第三个单元格。

我有这个数据:

在此处输入图像描述

我想从哪里复制 Col"D" 突出显示的单元格并将它们粘贴到 Col"B" <> 为空的同一行中。

这是最终结果。您在这方面的帮助将不胜感激。

在此处输入图像描述

Option Explicit
Sub CopyPasting()
    
Dim ws As Worksheet
Dim r As Long
Dim LastRow As Long
Dim n As Long
        
        Set ws = ThisWorkbook.Sheets("Sheet1")
        With ws
            LastRow = .Range("D" & .Rows.Count).End(xlUp).Row
            
        For r = LastRow To 2 Step -2
                If .Cells(r, "B") <> "" Then
                .Rows(r + "D").Copy
                .Rows(r + "D").PasteSpecial
    
            n = n + 1
            End If
            Next
    End With
    End Sub

标签: excelvbacopyoffset

解决方案


我不确定您想要输出的位置,这会将其放入名为“Sheet2”的工作表中。(你必须在运行它不会为你创建它的代码之前做到这一点。)

    Dim i As Long
    Dim j As Long
    Dim lr As Long
    Dim srcWS As Worksheet
    Dim destWS As Worksheet
    
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    Set destWS = ThisWorkbook.Sheets("Sheet2")
    
    With srcWS
        lr = .Cells(.Rows.Count, 4).End(xlUp).Row
        j = 2
        For i = 2 To lr
            If .Cells(i, 2).Value <> "" Then
                destWS.Cells(j, 1).Value = .Cells(i, 2).Value
                destWS.Cells(j, 2).Value = .Cells(i, 4).Offset(2, 0).Value
                j = j + 1
            End If
        Next i
    End With

如果您还需要复制颜色,请使用以下命令:

.Cells(i, 4).Offset(2, 0).Copy
destWS.Cells(j, 2).PasteSpecial xlPasteAll

代替:

destWS.Cells(j, 2).Value = .Cells(i, 4).Offset(2, 0).Value

推荐阅读