如果A列不存在，如何將A列從sheet1中的一行複製到sheet2

ZacMo 发表于 Dev

扎克莫

我想通過在 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

法尼杜魯

請測試下一個代碼：

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