代码写入时没有留空白行，求大神修改

笨笨的求知者

Sub CopyData()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng As Range, cell As Range
    Dim i As Long, j As Long

    Set ws1 = ThisWorkbook.Worksheets("表一")
    Set ws2 = ThisWorkbook.Worksheets("表二")

    '遍历表一的k列
    Set rng = ws1.Range("K1:K" & ws1.Cells(ws1.Rows.Count, "K").End(xlUp).Row)
    For Each cell In rng
        '判断是否为单行或合并单元格
        If cell.MergeArea.Cells.Count = 1 Or cell.MergeArea.Address <> cell.Address Then
            '判断后面是否有数据
            If cell.Offset(0, 1).Value <> "" Then
                '获取数据所在行的LMN列数据，并将其写入表二ABC列对应行
                i = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
                ws2.Range("A" & i).Value = CStr(cell.Offset(0, 1).Value)
                ws2.Range("B" & i).Value = CStr(cell.Offset(0, 2).Value)
                ws2.Range("C" & i).Value = CStr(cell.Offset(0, 3).Value)
            Else
                '在表二中添加一行留白.
                i = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
            End If
        End If
    Next cell


End Sub

求大神改下代码，具体情况如下:表一K列有单行和合并单元格，判断合并单元格或单行后面是否数据（合并单元格后有且仅有一行数据或无数据），有则将数据所在行的LMN列数据写入表二ABC列，没有则在表二留白换行，循环完k列所有行。程序运行后在表二中没有留空白行，请大神改下代码，谢谢

3190496160

调试代码更是应该上传附件才行

ykcbf1100

1楼的代码估计是Ai写的。

心的启点

ykcbf1100 发表于 2023-4-20 08:36
1楼的代码估计是Ai写的。

请教你是看哪里的区别啊！学习一下。

ykcbf1100

心的启点 发表于 2023-4-20 08:51
请教你是看哪里的区别啊！学习一下。

看过多篇chatgpt写的代码，其套路就是这样的。
有些写法，我们一般不会这样写。