Последний ряд разных листов и копировальная паста

Question

Я знаю, что вопрос "Последняя строка" уже поднимался несколько раз, но даже при просмотре существующих потоков я не могу найти, что происходит. Это первый раз, когда я пишу макрос, поэтому мне удалось добраться только до определенной точки, я вставляю код и задаю вопросы позже:

Option Explicit

Sub Practice()

'Last Row Searcher

Dim Sht As Worksheet
Set Sht = ActiveSheet
Dim Last_Row As Long
With Sht
    Last_Row = .Range("A9999").End(xlUp).Row
End With

'Column A to D
Sheet9.Select
Range("A2:A" & Last_Row).Copy
Sheet11.Select
Range("D" & Last_Row).Select
ActiveSheet.Paste

'Column C to F
Sheet9.Select
Range("C2:C" & Last_Row).Copy
Sheet11.Select
Range("F" & Last_Row + 1).Select
ActiveSheet.Paste

'Column E to G
Sheet9.Select
Range("E2:E" & Last_Row).Copy
Sheet11.Select
Range("G" & Last_Row + 1).Select
ActiveSheet.Paste

'Column I to L
Sheet9.Select
Range("I2:I" & Last_Row).Copy
Sheet11.Select
Range("L" & Last_Row + 1).Select
ActiveSheet.Paste

End Sub

Вопрос 1:

Когда я вставляю то, что скопировал на другой лист, он непосредственно вставляет вещи в «Last_Row» с предыдущего листа вместо того, чтобы искать новый «Last_Row» активного листа. Есть ли способ обойти это?

Вопрос 2

Я повторяю один и тот же код несколько раз, но с разными столбцами, потому что они не вместе, я копирую столбец A в D затем C F, et c.

Это работает для меня, но из любопытства, есть ли способ сделать все это сразу?

Answer 1

(Первая пустая строка после) Последняя непустая строка

Option Explicit

Sub Practice()

'Last Row Searcher

    Const frSrc As Long = 2                 ' Source First Row
    Const strSrc As String = "A,C, E, I"    ' Source Column Letters
    Const strTgt As String = "D, F,G, L"    ' Target Column Letters

    Dim wsSrc As Worksheet  ' Source Worksheet
    Dim wsTgt As Worksheet  ' Target Worksheet
    Dim rngSrc As Range     ' Source Column Range
    Dim rngTgt As Range     ' Target Column Range
    Dim vntS As Variant     ' Source Column Array
    Dim vntT As Variant     ' Target Column Array
    Dim lrSrc As Long       ' Source Last Non-Empty Row
    Dim frTgt As Long       ' Target First Row After Last Non-Empty Row
    Dim i As Long           ' Source and Target Array Elements Counter
    Dim colSrc As String    ' Source Column Letter
    Dim colTgt As String    ' Target Column Letter

    ' Beware, you are using CodeNames, which are not the names on the TAB.
    Set wsSrc = Sheet9
    Set wsTgt = Sheet11

    ' Populate Column Arrays (vntS, vntT).
    vntS = Split(strSrc, ","): vntT = Split(strTgt, ",")

    ' Loop through elements of Source (or Target) Column Array.
    For i = 0 To UBound(vntS)
        ' Calculate Column Letter (colSrc, colTgt)
        colSrc = Trim(vntS(i)): colTgt = Trim(vntT(i))
        ' Calculate Source Last Non-Empty Row.
        lrSrc = wsSrc.Range(colSrc & wsSrc.Rows.Count).End(xlUp).Row
        ' Calculate Target First Row After Last Non-Empty Row.
        frTgt = wsTgt.Range(colTgt & wsTgt.Rows.Count).End(xlUp).Row + 1
        ' Calculate Source Column Range.
        Set rngSrc = wsSrc.Range(colSrc & frSrc & ":" & colSrc & lrSrc)
        ' Calculate Target Column Range.
        Set rngTgt = wsTgt.Range(colTgt & frTgt).Resize(rngSrc.Rows.Count)
        ' Write values of Source Column Range to Target Column Range.
        rngTgt.Value = rngSrc.Value
    Next

End Sub

РЕДАКТИРОВАТЬ:

Sub Practice2()

'Last Row Searcher

    Const frSrc As Long = 2                 ' Source First Row
    Const strSrc As String = "A,C, E, I"    ' Source Column Letters
    Const strTgT As String = "D, F,G, L"    ' Target Column Letters

    Dim wsSrc As Worksheet  ' Source Worksheet
    Dim wsTgt As Worksheet  ' Target Worksheet
    Dim rngSrc As Range     ' Source Column Range
    Dim rngTgt As Range     ' Target Column Range
    Dim vntS As Variant     ' Source Column Array
    Dim vntT As Variant     ' Target Column Array
    Dim lrSrc As Long       ' Source Last Non-Empty Row
    Dim frTgt As Long       ' Target First Row After Last Non-Empty Row
    Dim i As Long           ' Source and Target Array Elements Counter
    Dim colSrc As String    ' Source Column Letter
    Dim colTgt As String    ' Target Column Letter

    ' Beware, you are using CodeNames, which are not the names on the TAB.
    Set wsSrc = Sheet9
    Set wsTgt = Sheet11

    ' Populate Column Arrays (vntS, vntT).
    vntS = Split(strSrc, ",")
    vntT = Split(strTgT, ",")

    ' Calculate Target First Row After Last Non-Empty Row.
    frTgt = wsTgt.Range(Trim(vntT(0)) & wsTgt.Rows.Count).End(xlUp).Row + 1

    ' Loop through elements of Source (or Target) Column Array.
    For i = 0 To UBound(vntS)
        ' Calculate Column Letter (colSrc, colTgt)
        colSrc = Trim(vntS(i)): colTgt = Trim(vntT(i))
        ' Calculate Source Last Non-Empty Row.
        lrSrc = wsSrc.Range(colSrc & wsSrc.Rows.Count).End(xlUp).Row
        ' Calculate Source Column Range.
        Set rngSrc = wsSrc.Range(colSrc & frSrc & ":" & colSrc & lrSrc)
        ' Calculate Target Column Range.
        Set rngTgt = wsTgt.Range(colTgt & frTgt).Resize(rngSrc.Rows.Count)
        ' Write values of Source Column Range to Target Column Range.
        rngTgt.Value = rngSrc.Value
    Next

End Sub

Answer 2

Добавление еще одного ответа здесь, потому что мой предыдущий ответ был неполным (и это беспокоит меня со вчерашнего дня!). Поскольку это повторяющийся фрагмент кода, я бы разделил копию столбца на его собственную подпрограмму. Ваша логика c становится очень простой в вашей основной рутине.

Option Explicit

Sub test()
    CopyMyColumn Sheet1.Range("A1").EntireColumn, Sheet1.Range("D1").EntireColumn
    CopyMyColumn Sheet1.Range("C1").EntireColumn, Sheet1.Range("F1").EntireColumn
    CopyMyColumn Sheet1.Range("E1").EntireColumn, Sheet1.Range("G1").EntireColumn
    CopyMyColumn Sheet1.Range("I1").EntireColumn, Sheet1.Range("L1").EntireColumn
End Sub

Private Sub CopyMyColumn(ByRef srcColumn As Range, ByRef dstColumn As Range)
    '--- copies the source column from row 2 to the end of the data, to
    '    the destination column, appending to the end of the existing data
    Dim srcLastRow As Long
    With srcColumn
        srcLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

    Dim dstLastRow As Long
    With dstColumn
        dstLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

    Dim src As Range
    Dim dst As Range
    Set src = srcColumn.Cells(2, 1).Resize(srcLastRow, 1)
    Set dst = dstColumn.Cells(1, 1).Offset(dstLastRow, 0).Resize(srcLastRow, 1)
    dst.Value = src.Value
End Sub

Answer 3

Вам нужно задать определение "последней строки" более четко. В вашем случае я считаю, что вам нужно найти последнюю строку исходных данных И затем вставить ее после последней строки вашего листа назначения. Поэтому попробуйте что-то вроде этого:

Dim srcWS As Worksheet
Set srcWS = Sheet9

Dim dstWS As Worksheet
Set dstWS = Sheet11

Dim srcLastRow As Long
With srcWS
    srcLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

Dim dstLastRow As Long
With dstWS
    dstLastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
End With

srcWS.Range("A2:A" & srcLastRow).Copy
dstWS.Range("D" & dstLastRow).Paste

Нет Select или ActiveSheet необходимо (чего следует избегать, когда вы можете).