如何将 A 列复制到 M，如果它不存在，从工作表 1 中的行复制到工作表 2

Question

我想通过在列L中放置X来选择一些行，然后将选定的行(仅列A到M)复制到sheet2中的下一个自由行。

空行是指在A到M列中没有任何内容，因为下一列中已经填充了内容。

复制不应该删除m列之后已经存在的内容。

如果该行已经在sheet2中，则不能添加该行，为了测试这一点，我为m列中的行设置了唯一ID

需要复制的行中有些列有时是空的。

我尝试的部分内容:

Sub GAtoList()
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim L As Long

A = Worksheets("knxexport").Range("d" & Worksheets("knxexport").Rows.Count)
B = Worksheets("Sheet2").UsedRange.Rows.Count

If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("knxexport").Range("L1:L" & A)
Application.ScreenUpdating = False
For L = 1 To xRg.Count
If CStr(xRg(L).Value) = "X" Then
xRg(L).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & B + 1)
B = B + 1
Cells(L, B).EntireRow.Interior.ColorIndex = 4

End If
Next
'Erase the X that select the row I want to copy
Worksheets("knxexport").Columns(12).ClearContents
Worksheets("Sheet2").Columns(12).ClearContents
Application.ScreenUpdating = True
End Sub

D列从来不是空的，所以我用它来检查源工作表

的结尾knxexport表，我取数据

sheet2，我想复制它们

Answer 1

请测试下一个代码:

Sub GAtoList()
Dim sh As Worksheet, shDest As Worksheet, lastRL As Long, LastRM As Long
Dim strSearch As String, rngM As Range, arrCopy, cellF As Range, rngL As Range, cellFAddress As String, i As Long, mtch

strSearch = "X"
Set sh = 'Worksheets("knxexport")   'the sheet to copy from
Set shDest = 'Worksheets("Sheet2")  'the sheet to copy to
shDest.Range("M:M").NumberFormat = "@" 'format the M:M column as text
lastRL = sh.Range("L" & sh.rows.count).End(xlUp).row
Set rngL = sh.Range("L2:L" & lastRL) 'the range to search for "X"
Set cellF = rngL.Find(what:=strSearch, After:=sh.Range("L2"), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)
If Not cellF Is Nothing Then     'If at least an "X" string has been found:
cellFAddress = cellF.Address  'memorize its (first) address
Do
LastRM = shDest.Range("M" & shDest.rows.count).End(xlUp).row 'last row in M:M
If LastRM > 1 Then  'if there already are IDs:
Set rngM = shDest.Range("M2:M" & LastRM)
mtch = Application.match(sh.cells(cellF.row, "M").Value, rngM, 0)
If IsError(mtch) Then 'no ID found
shDest.Range("A" & LastRM + 1 & ":" & "M" & LastRM + 1).Value = _
sh.Range(sh.Range("A" & cellF.row), sh.Range("M" & cellF.row)).Value
Else
Debug.Print sh.cells(cellF.row, "M").Value & " already existing..." 'warn in case of ID existence...
End If
Else
'copy in the second row
shDest.Range("A2:M2").Value = _
sh.Range(sh.Range("A" & cellF.row), sh.Range("M" & cellF.row)).Value
End If
Set cellF = rngL.FindNext(cellF)
Loop While cellF.Address <> cellFAddress 'exit to avoid restarting loop from the memorized address   
Else
MsgBox strSearch & " could not be found in ""L:"" column...": Exit Sub
End If
End Sub