Скопируйте данные на новый лист, исключая последние 4 строки

Question

Я пытаюсь скопировать таблицу из листа 1, определенной областью D21: O21, до конца - (минус) последние 4 строки.

У меня проблема с вставкой результатов. На листе 2 у меня есть таблица, которая подает сводные диаграммы. После того, как я удаляю предыдущие заполненные строки (со значениями) и вставляю новые (новые значения), таблица расширяется дальше, чем предполагалось. Он добавляет пустые ячейки вниз по течению, как если бы на скопированном листе 1 было больше строк со значениями.

Например: представьте, что моя таблица (на листе 1) имеет 600 строк со значениями. Если я вставлю таблицу (на листе 2), она простирается еще на 600 строк (около 10000). Вместо добавления нескольких пустых строк мне нужно 600, кроме последних 4 строк = сверху до 596 строк.

Sub Prime()

Dim Last_Row1 As Long, Last_Row2 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Sheets("Enter DATA here")
    Set ws2 = Sheets("DATA")
    Application.ScreenUpdating = False
    Last_Row1 = ws1.Range("C" & Rows.Count).End(xlUp).Row ' Determine the lastrow of the data to copy
    Last_Row2 = ws2.Range("A" & Rows.Count).End(xlUp).Row ' Determine the next empty row in order to paste the data
    ws1.Range("D21:O21" & Last_Row1).Copy ws2.Range("A" & Last_Row2)
Application.ScreenUpdating = True

End Sub

Answer 1

   Sub Prime()

 Dim Last_Row1 As Long, Last_Row2 As Long
 Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Sheets("Enter DATA here")
    Set ws2 = Sheets("DATA")
    Application.ScreenUpdating = False
    Last_Row1 = ws1.Range("C" & Rows.Count).End(xlUp).Row ' Determine the lastrow of the data to copy
    Last_Row2 = ws2.Range("A" & Rows.Count).End(xlUp).Row ' Determine the next empty row in order to paste the data
    ws1.Range("D21:O" & Last_Row1-4).Copy ws2.Range("A" & Last_Row2)
Application.ScreenUpdating = True

End Sub

Answer 2

Вы можете использовать функцию смещения, чтобы исключить последние 4 строки.

Last_Row1 = ws1.Range("C" & Rows.Count).End(xlUp).offset(-4,0).Row 

Когда вы копируете диапазон, вы должны удалить индикатор строки «21» за столбцом «O», иначе код не будет выбран до последней строки. Нравится следующее:

ws1.Range("D21:O" & Last_Row1).Copy ws2.Range("A" & Last_Row2)

Answer 3

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

Sub Prime()
    Dim Last_Row1 As Long, Last_Row2 As Long, table As Range
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = Sheets("Enter DATA here")
    Set ws2 = Sheets("DATA")

    Set table = ws1.Range("D21:O28")   // I arbitrarily set this to 8 rows

    Application.ScreenUpdating = False

        Last_Row1 = ws1.Range("C" & Rows.Count).End(xlUp).Row ' Determine the lastrow of the data to copy
        Last_Row2 = ws2.Range("A" & Rows.Count).End(xlUp).Row ' Determine the next empty row in order to paste the data
        table.Resize(table.Rows.Count - 4, table.Columns.Count).Copy ws2.Range("A" & Last_Row2)

    Application.ScreenUpdating = True
End Sub