如何将两行数据复制到一列并删除重复项

Question

需要帮助将两行数据复制为一行并删除重复项 - 数据从 B4 和 L4 列开始。我想复制从单元格 E4 开始的两列。此后，我需要删除重复项。

Sub Delete_duplicates()

' Delete_duplicates Macro

Dim ws As Worksheet
Dim lastRowB As Long
Dim lastRowL As Long
Dim lastRowE As Long

Set ws = ThisWorkbook.Sheets("PS  Analysis")

' Find the last row with data in column B and column L

lastRowB = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

lastRowL = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row

ws.Range("B3").Copy

Destination = ws.Range("B4:B" & lastRowB)

ws.Range("L3").Copy

Destination = ws.Range("L4:B" & lastRowB) 

' FInd the last row in column E to start copying the data

lastRowE = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row + 1

' Copy bpth columns B  & L starting at E4
 
ws.Range("B4:B" & lastRowB).Copy

Destination = ws.Range("E4")

ws.Range("L4:L" & lastRowL).Copy

Destination = ws.Cells(lastRowE, "E")
 
End Sub

Answer 1

Option Explicit

Sub Delete_duplicates()

    ' Delete_duplicates Macro
    Dim ws As Worksheet
    Dim lastRowB As Long, lastRowL As Long, lastRowE As Long
    
    Set ws = ThisWorkbook.Sheets("PS  Analysis")
    With ws
        ' Find the last row with data in column B copy to E
        lastRowB = .Cells(.Rows.Count, "B").End(xlUp).Row
        .Range("B4:B" & lastRowB).Copy .Range("E4")
        
        ' Find the last row with data in column L copy to E
        lastRowE = .Cells(.Rows.Count, "E").End(xlUp).Row
        lastRowL = .Cells(.Rows.Count, "L").End(xlUp).Row
        .Range("L4:L" & lastRowL).Copy .Range("E" & lastRowE)
        
        ' remove duplicates in column E
        lastRowE = .Cells(.Rows.Count, "E").End(xlUp).Row
        .Range("E4:E" & lastRowE).RemoveDuplicates Columns:=Array(1)
    End With
 
End Sub