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

Question

Вот код, который работает для копирования Z4: Z11, а затем вставьте его в строку.Однако, когда я запускаю его снова, он просто вставляет текущие данные, я хочу запустить его до следующей строки.

Sub SaveLineup()
'
' SaveLineup Macro
'

'
Range("Z4:Z11").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A3").Select
Sheets("Sheet1").Select
Application.CutCopyMode = False
Range("Z13").Select
End Sub

Answer 1

Вы можете избежать использования Select, транспонируя значения из Z4: Z11 в столбцы A: H.

Находите следующую пустую строку каждый раз при выполнении подпрограммы.

Sub SaveLineup()

    Dim nr As Long

    With Worksheets("sheet3")
        nr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        With .Range("Z4:Z11")
            .Parent.Cells(nr, "A").Resize(.Columns.Count, .Rows.Count) = _
              Application.Transpose(.Value)
        End With
    End With

End Sub

Answer 2

A Fast Transpose

Sub TransposeColumn()

  Const cSource As Variant = "Sheet1"   ' Source Worksheet Name/Index
  Const cTarget As Variant = "Sheet2"   ' Target Worksheet Name /Index
  Const cRange As String = "Z4:Z11"     ' Source Range
  Const cColumn As String = "A"         ' Target Column

  Dim vntRange As Variant               ' Source Array

  ' Paste Source Range into Source Array.
  vntRange = Worksheets(cSource).Range(cRange)

  With Worksheets(cTarget)
    ' Resize the cell below the calculated last row in Target Column by
    ' the size of Source Array for transposing i.e. the array contains rows,
    ' but resize by column and paste the Source Array into the resulting
    ' Target Range.
    .Cells(.Cells(.Rows.Count, cColumn).End(xlUp).Row + 1, cColumn) _
        .Resize(, UBound(vntRange)) = vntRange
  End With

End Sub

Answer 3

Попробуйте это:

Option Explicit
Sub Test()

Dim sht As Worksheet, sht2 As Worksheet, lastrow As Long

Set sht = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
lastrow = sht2.Cells(sht2.Rows.Count, 1).End(xlUp).Row + 1

sht2.Range(sht2.Cells(lastrow, 1), sht2.Cells(lastrow + 7, 1)).Value = _
sht.Range(sht.Cells(4, 26), sht.Cells(11, 26)).Value

End Sub