从第2页复制到最后一个单元格

Question

好的，这很难解释，如果我告诉你会更好。

我正在从第2页提取数据 - 细胞A＆amp;乙

每次行数不同，所以我正在尝试将单元格从第1页上的预制框复制到第2页上行的末尾。

在第2页上说，行停在25，我只希望它在第1页上复制25x

以下是它的外观，如果我突出显示该框，然后将鼠标放在右下方，我可以将其向下拖动并将其复制给我。这就是我正在尝试使宏做的。

但是，我不知道我的宏用什么？！

Sub Test()'

    Range("G2:J3").Select
    Range("J3").Activate
    Selection.AutoFill Destination:=Range("G2:J5"), Type:=xlFillDefault
    Range("G2:J5").Select
End Sub

Answer 1

好的，所以从LastCell开始，在这里你得到了一些关于它的信息：http://www.cpearson.com/excel/LastCell.aspx

这不是那么容易，因为你已经合并了细胞，所以我不得不做一些解决方法。第一步我在您的示例中计算工作表List中的单元格数。后来我使用自动填充根据需要填充尽可能多的单元格 - 列G：I并在列J中的相同单元格中复制格式。最后一步是复制J列中的值。

这有点奇怪，但这完全归功于合并的细胞;）

希望它有效。

Sub counting()

Dim WS As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long

Set WS = Worksheets("List") 'your worksheet name
With WS
    Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
    LastCellRowNumber = LastCell.Row
End With

Worksheets("Barcodes").Range(Cells(2, 7), Cells(3, 9)).AutoFill _
Destination:=Range(Cells(5, 7), Cells(6 + (LastCellRowNumber * 2) - 4, 9)), Type:=xlFillDefault 'filling columns from G to I
Worksheets("Barcodes").Range(Cells(2, 10), Cells(3, 10)).AutoFill _
Destination:=Range(Cells(5, 10), Cells(6 + (LastCellRowNumber * 2) - 4, 10)), Type:=xlFillFormats ' filling with format J column

j = 4
k = 5

For i = 6 To LastCellRowNumber 'filling values in column J

    Cells(j, 10).Value = "=List!A" & i
    Cells(k, 10).Value = "=List!B" & i

    j = j + 2
    k = k + 2

Next

End Sub

编辑代码版本2：

Sub counting()

Dim WS As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long

Set WS = Worksheets("List") 'your worksheet name
With WS
    Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
    LastCellRowNumber = LastCell.Row
End With

Worksheets("Barcodes").Range(Cells(5, 7), Cells(6, 7)).AutoFill _
Destination:=Range(Cells(5, 7), Cells(6 + (LastCellRowNumber * 2) - 4, 7)), Type:=xlFillDefault 'filling column G

Worksheets("Barcodes").Range(Cells(5, 8), Cells(6, 9)).AutoFill _
Destination:=Range(Cells(5, 8), Cells(6 + (LastCellRowNumber * 2) - 4, 9)), Type:=xlFillFormats 'filling with columns H:J

j = 7
k = 8

For i = 3 To LastCellRowNumber 'copying values in columns I, J

    Cells(j, 9).Value = "=List!A" & i
    Cells(j, 8).Value = Cells(j - 2, 8).Value
    Cells(k, 9).Value = "=List!B" & i
    Cells(k, 8).Value = Cells(k - 2, 8).Value

    j = j + 2
    k = k + 2

Next

End Sub

第v3版：

Sub auto_copy()

Dim WSL As Worksheet, WSB As Worksheet
Dim first_col As Long, second_col As Long
Dim first_r As Byte, first_c As Byte
Dim second_r As Byte, second_c As Byte
Dim LastCellRowNumber As Long, comeback As String
Dim LastCell As Range, ActiveWS As String

Application.ScreenUpdating = False

ActiveWS = ActiveSheet.Name

Set WSB = Worksheets("Barcodes") 'your worksheet name
Set WSL = Worksheets("List") 'your worksheet name
With WSL
    Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
    LastCellRowNumber = LastCell.Row - 3
End With

first_col = Round(LastCellRowNumber / 2)
second_col = LastCellRowNumber - first_col

first_r = 5 'position of "first column" row
first_c = 7 'position of "first column" column
second_c = 11 'position of "first column" column

WSB.Activate

comeback = ActiveCell.Address

For i = 1 To LastCellRowNumber

    If Application.IsOdd(i) = True Then

    WSB.Range(Cells(first_r, first_c), Cells(first_r + 1, first_c)).Copy
    WSB.Range(Cells(first_r + 2, first_c), Cells(first_r + 1 + 2, first_c)).PasteSpecial
    WSB.Range(Cells(first_r, first_c + 1), Cells(first_r + 1, first_c + 2)).Copy
    WSB.Range(Cells(first_r + 2, first_c + 1), Cells(first_r + 1 + 2, first_c + 2)).PasteSpecial

    Else

    WSB.Range(Cells(first_r, second_c), Cells(first_r + 1, second_c)).Copy
    WSB.Range(Cells(first_r + 2, second_c), Cells(first_r + 1 + 2, second_c)).PasteSpecial
    WSB.Range(Cells(first_r, second_c + 1), Cells(first_r + 1, second_c + 2)).Copy
    WSB.Range(Cells(first_r + 2, second_c + 1), Cells(first_r + 1 + 2, second_c + 2)).PasteSpecial

    first_r = first_r + 2

    End If

Next

Range(comeback).Activate

Worksheets(ActiveWS).Activate

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub