скопировать значения из Sheet1 и Sheet2 вставить в лист загрузки

Question

У меня есть значения в Sheet1 и sheet2 в столбцах A, B, C, D и E. Кроме того, эти значения являются некоторыми значениями vlookup из других листов.Теперь, как мне написать код для копирования (только) этих значений из sheet1 и sheet2 и вставить в Upload sheet.

ПРИМЕЧАНИЕ: столбецЗначение в Sheet1 и sheet2 ,

• ** A ** для копирования в D загрузки,
• B для копирования в столбец F загрузки,
• C для копирования в C столбец загрузки,
• D для копирования в E загрузки

И каждый раз количество копируемых копий будет отличаться.Поэтому, когда sheet1 копируется в Upload, он должен найти следующую доступную строку и начать копировать в нее значения из sheet2.

Private Sub CommandButton1_Click() Dim firstrowDB1 As Long, lastrow1 As 
Long Dim lastcol As Long, firstrowDB As Long Dim arr1, arr2, i, 
firstRowCount As Integer firstrowDB1 = 1
arr1 = Array("A", "B", "C", "D")
arr2 = Array("D", "F", "C", "E")
For i = LBound(arr1) To UBound(arr1)
    Sheets("Sheet1").Columns(arr1(i)).Copy

    Sheets("upload").Columns(arr2(i)).PasteSpecial xlPasteValues
Next
Application.CutCopyMode = False

Приведенный выше код хорошо работает для копирования sheet1 в Upload в определенных столбцах, но яНе делайте, как я должен выделить следующую пустую ячейку в листе загрузки и начать копирование и вставку значений из листа 2.

Требуется помощь, пожалуйста!

Answer 1

Я пытался нанести удар, используя ваш метод.Я использовал номера столбцов в массиве, а не букву
(A = 1, B = 2, C = 3, и т. Д. )

Это короче, но гораздо сложнееследовать.При этом всегда будет использоваться Column A в качестве индикатора того, где находится последний ряд (снизу вверх, скорее сверху вниз). Не проверено

---

Option Explicit

Sub Parsley()

Dim CopyArr: CopyArr = Array(1, 2, 3, 4)
Dim PasteArr: PasteArr = Array(4, 6, 3, 5)
Dim ws: ws = Array("Sheet1", "Sheet2")

Dim ws3 As Worksheet: Set ws3 = ThisWorkbook.Sheets("Upload")

Dim i As Integer, j As Integer, LRow As Long, uLRow As Long

Application.ScreenUpdating = False
    For i = LBound(ws) To UBound(ws)
        Set ws = Sheets(ws(i))
        LRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        uLRow = ws3.Range("A" & ws3.Rows.Count).End(xlUp).Offset(1).Row
            For j = LBound(CopyArr) To UBound(CopyArr)
                ws.Range(ws.Cells(2, CopyArr(j)), ws.Cells(LRow, CopyArr(j))).Copy
                ws3.Cells(uLRow, PasteArr(j)).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            Next j
    Next i
Application.ScreenUpdating = True

End Sub

Answer 2

Это выглядит много, но так как вы переключаете столбцы, требуется много итераций копирования / вставки.Вы также можете сделать интервалы равными друг другу и сэкономить время, но я здесь этого не делал.

Обратите внимание, что вам нужно пересчитать последнюю строку на Upload, как только вы закончили вставку значений из Sheet 1.Вместо того, чтобы пересчитать LRow3, вы могли бы просто немного посчитать.Второе вычисление LRow3 также будет равно начальному значению LRow3 + LRow1 - 1.

Отключено обновление экрана для повышения производительности

---

Option Explicit

Sub Parsley()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim Upl As Worksheet: Set Upl = ThisWorkbook.Sheets("Upload")

Dim LRow1 As Long, LRow2 As Long, LRow3 As Long

LRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
LRow3 = Upl.Range("A" & Upl.Rows.Count).End(xlUp).Offset(1).Row

Application.ScreenUpdating = False
    ws1.Range("A2:A" & LRow1).Copy: Upl.Range("D" & LRow3).PasteSpecial xlPasteValues
    ws1.Range("B2:B" & LRow1).Copy: Upl.Range("F" & LRow3).PasteSpecial xlPasteValues
    ws1.Range("C2:C" & LRow1).Copy: Upl.Range("C" & LRow3).PasteSpecial xlPasteValues
    ws1.Range("D2:D" & LRow1).Copy: Upl.Range("E" & LRow3).PasteSpecial xlPasteValues

    LRow3 = Upl.Range("A" & Upl.Rows.Count).End(xlUp).Offset(1).Row

    ws2.Range("A2:A" & LRow2).Copy: Upl.Range("D" & LRow3).PasteSpecial xlPasteValues
    ws2.Range("B2:B" & LRow2).Copy: Upl.Range("F" & LRow3).PasteSpecial xlPasteValues
    ws2.Range("C2:C" & LRow2).Copy: Upl.Range("C" & LRow3).PasteSpecial xlPasteValues
    ws2.Range("D2:D" & LRow2).Copy: Upl.Range("E" & LRow3).PasteSpecial xlPasteValues
Application.ScreenUpdating = True

End Sub