如何在更改列时复制数据

Question

我又来了...我有一些代码可以从特定列（来自 sheet "Convertor"）复制单元格并将其粘贴到不同的列（sheet "Unallocated").然后将这些值（ID）用作参考点，将每行（记录）的其余单元格移动到我需要的正确位置。

但是我无法获取代码来连续将 ID 复制到空白行中，以免它们覆盖之前的集合。我认为这与 Master.Cells(rowB, colB) = yourData 行有关，但我无法弄清楚。我尝试将 rowB 更改为相同的 xlUp 以查找列中最后一个未使用的单元格（与 lastA = Slave.Cells(Rows.Count, colA).End(xlUp).Row 一样），但我无法让它工作。有什么想法吗？

当前代码：

Private Sub CommandButton21_Click()

Dim colA As Integer, colB As Integer
Dim rowA As Integer, rowB As Integer
Dim Master As Worksheet, Slave As Worksheet 'declare both

Application.ScreenUpdating = False

Set Master = ThisWorkbook.Worksheets("Unallocated")
Set Slave = ThisWorkbook.Worksheets("Convertor")

colA = 17 
colB = 29 

rowA = 1 
rowB = 1 

lastA = Slave.Cells(Rows.Count, colA).End(xlUp).Row 'This finds the last row of the data of the column FROM which i'm copying
For x = rowA To lastA 'Loops through all the rows of A
    yourData = Cells(x, colA)
    Master.Cells(rowB, colB) = yourData
    rowB = rowB + 1 'Increments the current line of destination workbook
Next x 'Skips to next row

For j = 1 To 5000 '(the master sheet)

    For i = 1 To 5000 '(the slave sheet) 'for first 1000 cells

        If Trim(Master.Cells(j, 29).Value2) = vbNullString Then Exit For 'if ID cell is blank exit

        If Master.Cells(j, 29).Value = Slave.Cells(i, 17).Value Then

            If IsEmpty(Slave.Cells(i, 3)) Then Exit Sub

            Master.Cells(j, 2).Value = Slave.Cells(i, 3).Value 'Move all other data based on the ID
            Master.Cells(j, 8).Value = Slave.Cells(i, 4).Value
            Master.Cells(j, 9).Value = Slave.Cells(i, 5).Value
            Master.Cells(j, 10).Value = Slave.Cells(i, 6).Value
            Master.Cells(j, 11).Value = Slave.Cells(i, 7).Value
            Master.Cells(j, 12).Value = Slave.Cells(i, 8).Value
            Master.Cells(j, 13).Value = Slave.Cells(i, 9).Value
            Master.Cells(j, 4).Value = Slave.Cells(i, 10).Value
            Master.Cells(j, 23).Value = Slave.Cells(i, 11).Value
            Master.Cells(j, 24).Value = Slave.Cells(i, 12).Value
            Master.Cells(j, 25).Value = Slave.Cells(i, 13).Value
            Master.Cells(j, 26).Value = Slave.Cells(i, 14).Value
            Master.Cells(j, 27).Value = Slave.Cells(i, 15).Value
            Master.Cells(j, 28).Value = Slave.Cells(i, 16).Value

            If Not IsEmpty(Slave.Cells(i, 3)) Then _
            Slave.Cells(i, 3).EntireRow.Delete 'deletes row after it has been copied

        End If
    Next

Next

Application.ScreenUpdating = True

End Sub

Answer 1

.Cells 限制了您的方法。

考虑更改为使用 Range("A1:C3000") 符号，它更强大。

Range.Select Range.Paste（到目的地 UsedRows.Count 的新高标记）

此外，除非您恰好有 5000 行，否则它不会那么准确，

试验

ActiveSheet.UsedRange.Rows.Count

Answer 2

让我们从为每一行复制数据的简单循环开始。然后你可以添加你的支票。

您可以使用 worksheet.range 写入单元格（列行），例如 ("A4") 或 ("A" & counter)。

Private Sub CommandButton21_Click()
    Dim ws As Excel.Worksheet
    Dim wsMaster As Excel.Worksheet
    Dim strValue As String

    Set ws = ActiveWorkbook.Sheets("Convertor")
    Set wsMaster = ActiveWorkbook.Sheets("Unallocated")

    'Count of row to read from
    Dim lRow As Long
    lRow = 1

    'Count of row to write to
    Dim jRow As Long
    jRow = 1

    ws.Activate
    'Loop through and copy what is in the rows
    Do While lRow <= ws.UsedRange.Rows.count

        wsMaster.Range("AC" & jRow).Value = ws.Range("Q" & lRow).Value

        wsMaster.Range("B" & jRow).Value = ws.Range("C" & lRow).Value
        wsMaster.Range("H" & jRow).Value = ws.Range("D" & lRow).Value
        wsMaster.Range("I" & jRow).Value = ws.Range("E" & lRow).Value
        wsMaster.Range("J" & jRow).Value = ws.Range("F" & lRow).Value
        wsMaster.Range("K" & jRow).Value = ws.Range("G" & lRow).Value
        wsMaster.Range("L" & jRow).Value = ws.Range("H" & lRow).Value
        wsMaster.Range("M" & jRow).Value = ws.Range("I" & lRow).Value
        wsMaster.Range("D" & jRow).Value = ws.Range("J" & lRow).Value
        wsMaster.Range("W" & jRow).Value = ws.Range("K" & lRow).Value
        wsMaster.Range("X" & jRow).Value = ws.Range("L" & lRow).Value
        wsMaster.Range("Y" & jRow).Value = ws.Range("M" & lRow).Value
        wsMaster.Range("Z" & jRow).Value = ws.Range("N" & lRow).Value
        wsMaster.Range("AA" & jRow).Value = ws.Range("O" & lRow).Value
        wsMaster.Range("AB" & jRow).Value = ws.Range("P" & lRow).Value

        ws.Rows(lRow).EntireRow.Delete

        'Increment counters for both sheets. We can actually use just one counter, but if there is ever a condition that will cause us to not copy a row, then we will need two counters.
        jRow = jRow + 1
        'lRow = lRow + 1 'This is commented out because we are deleting rows after we copy them.

    Loop
End Sub

如果您确实需要在复制行后删除行，那么我们将不得不不增加 lRow 值。

如何在更改列时复制数据

How to copy data whilst changing column

excel

vba

copy