почему мой SUB X удаляет всю строку данных

Question

Я делаю в своей личной подпапке данные и перемещаю их с одного листа на другой. Но когда я запускаю «Sub X», он возвращается к листу, с которого я получаю свои данные, и удаляю строку («M») данных. Я пытался исправить это, но безуспешно. Тогда я просто получаю "несоответствие".

Надеюсь, вы можете помочь, спасибо.

Sub MyProcedure()
    a = Worksheets("ark1").Cells(Rows.Count, 1).End(xlUp).Row

    MsgBox (a)

End Sub

Private Sub CommandButton1_Click()
    Dim nøgletal As String, år As Integer
    Worksheets("Ark2").Select
    nøgletal = Range("B2")
    år = Range("C2")
    Worksheets("Ark1").Select
    Worksheets("Ark1").Range("A4").Select
    ThisWorkbook.Worksheets("Ark1").Range("A1:A100").Value = ThisWorkbook.Worksheets("Ark2").Range("A12:A100").Value
    ThisWorkbook.Worksheets("Ark1").Range("B1:B100").Value = ThisWorkbook.Worksheets("Ark2").Range("B12:B100").Value
    ThisWorkbook.Worksheets("Ark1").Range("C1:C100").Value = ThisWorkbook.Worksheets("Ark2").Range("C12:C100").Value
    ThisWorkbook.Worksheets("Ark1").Range("E1:E100").Value = ThisWorkbook.Worksheets("Ark2").Range("E12:E100").Value
    ThisWorkbook.Worksheets("Ark1").Range("G1:G100").Value = ThisWorkbook.Worksheets("Ark2").Range("M12:M100").Value
    ThisWorkbook.Worksheets("Ark1").Range("F1:F100").Value = ThisWorkbook.Worksheets("Ark2").Range("N12:N100").Value
    ThisWorkbook.Worksheets("Ark1").Range("H1:H100").Value = ThisWorkbook.Worksheets("Ark2").Range("O12:O100").Value
    If Worksheets("Ark1").Range("A4").Offset(1, 0) <> "" Then
        Worksheets("Ark1").Range("A4").End(xlDown).Select
    End If
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = nøgletal
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = år
    Worksheets("Ark2").Select
    Worksheets("Ark2").Range("B2", "B16").Select
End Sub

Sub x()

    Dim lngDataColumns As Long
    Dim lngDataRows As Long

    lngDataColumns = 3
    lngDataRows = 50


    For t = 1 To lngDataRows

        Range("l2").Offset(((t - 1) * lngDataColumns) - 1, 0).Resize(lngDataColumns, 1).Value = _
                Application.Transpose(Range("f1:h1").Value)

        Range("M2").Offset(((t - 1) * lngDataColumns) - 1, 0).Resize(lngDataColumns, 1).Value = _
                Application.Transpose(Range("f1:h1").Offset(t).Value)

    Next t

End Sub

Answer 1

Если подпроцедура X находится в закрытом кодовом листе рабочего листа, а не в кодовом листе открытого модуля, Range или Cells будет всегда неявно принадлежат этому листу, если явно не указан другой родительский лист.

Если у вас возникли проблемы с указанием исходного и целевого рабочих листов, возможно, эффективный метод - передать их в подпроцедуру X в качестве параметров.

Option Explicit

Sub runXfer()

    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = Worksheets("ark1")    '<~~ source
    Set ws2 = Worksheets("ark2")    '<~~ target

    Xfer ws1, ws2

End Sub

Sub Xfer(w1 As Worksheet, w2 As Worksheet)

    Dim i As Long, lr As Long, cs As Long, hdr As Variant

    With w1
        cs = 3
        lr = .Cells(.Rows.Count, "E").End(xlUp).Row
        hdr = Application.Transpose(.Cells(1, "E").Resize(1, cs).Value2)

        For i = 2 To lr
            w2.Cells(3, "L").Offset((i - 2) * cs, 0).Resize(cs, 1) = hdr
            w2.Cells(3, "M").Offset((i - 2) * cs, 0).Resize(cs, 1) = _
                Application.Transpose(.Cells(i, "E").Resize(1, cs).Value2)
        Next i

    End With

End Sub