Excel – объединение 2 листов в третий в пустую строку

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

LastRow = Sheets("CmrDetails").Cells(Sheets("CmrDetails").Rows.Count, 1).End(xlUp).Row + 1

Теперь мы можем изменить копирование данных из ImportData на динамическое, а вставку в CmrDetails сделать в первой открытой строке после вставки из HistoricalData.

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

Sheets("ImportData").Range("X2:X" & LR1).Copy Sheets("CmrDetails").Range("B" & LastRow & ":B" & LastRow + LR1 - 1)
Sheets("ImportData").Range("D2:D" & LR1).Copy
Sheets("CmrDetails").Range("A" & LastRow & ":A" & LastRow + LR1 - 1).PasteSpecial xlPasteValues
Sheets("ImportData").Range("AX2:AX" & LR1).Copy Sheets("CmrDetails").Range("C" & LastRow & ":C" & LastRow + LR1 - 1)

Импорт и консолидация данных

Быстрое решение

Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

Dim iws As Worksheet: Set iws = wb.Sheets("ImportData")
Dim dws As Worksheet: Set dws = wb.Sheets("CmrDetails")

Dim irg As Range: Set irg = iws.Rows("2:350")
Dim drg As Range: Set drg = dws.Cells(dws.Rows.Count, "A").End(xlUp) _
    .Offset(1).EntireRow.Resize(irg.Rows.Count)
    
iws.Columns("X").Copy Destination:=dws.Columns("B")
dws.Columns("A").Value = iws.Columns("D").Value ' only values
iws.Columns("AX").Copy Destination:=dws.Columns("C")

Улучшение

Private Sub CommandButton1_Click()
    ImportCsvData
End Sub

Sub ImportCsvData()
    
    Const PROC_TITLE As String = "Import CSV Data"
    
    ' Define constants.

    Const SRC_FILE_FILTER As String = "Text files (*.CSV),*.CSV"
    Const SRC_DIALOG_TITLE As String = "Source File Selection"
    
    Const INP_SHEET_NAME As String = "ImportData"
    Const INP_FIRST_CELL As String = "A1"
    Const INP_INSERT_COLUMN As String = "D"
    Const INP_INSERT_COLUMN_FORMULAR1C1 As String = "=TEXT(R[0]C[-1], ""mmm"")"
    
    Const COPY_SHEET_NAME As String = "HistoricalData"
    
    Const DST_SHEET_NAME As String = "CmrDetails"
    Const DST_LAST_ROW_COLUMN As String = "A"
    
    Const FIRST_ROWS As String = "2:51" ' 50 rows
    Const SECOND_ROWS As String = "52:350" ' 349 rows, maybe "52:351"?
    
    ' Destination
    
    ' Reference the destination workbook.
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    
    ' Reference the Input sheet and clear it.
    Dim iws As Worksheet: Set iws = dwb.Sheets(INP_SHEET_NAME)
    iws.UsedRange.Clear
    
    ' Let the user select a file.
    Dim sFilePath As Variant: sFilePath = Application.GetOpenFilename( _
        FileFilter:=SRC_FILE_FILTER, Title:=SRC_DIALOG_TITLE)
    If sFilePath = False Then
        MsgBox "No file selected!", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    ' Copy data from the Source sheet to the Input sheet.
    
    Dim swb As Workbook: Set swb = Workbooks.Open( _
        Filename:=sFilePath) ' if necessary, try with 'Local:=True'
    Dim ifCell As Range: Set ifCell = iws.Range(INP_FIRST_CELL)
    swb.Sheets(1).UsedRange.Copy ifCell
    swb.Close SaveChanges:=False
        
    ' Destination
        
    ' Insert the specified column and populate it with the header
    ' and formulas from the 2nd to the last row.
    iws.Columns(INP_INSERT_COLUMN).EntireColumn.Insert Shift:=xlToRight
    With ifCell
        Dim iLR As Long:
        iLR = iws.Cells(iws.Rows.Count, .Column).End(xlUp).Row
        With .EntireRow.Columns(INP_INSERT_COLUMN)
            .Value = "Month" ' write header
            .Offset(1).Resize(iLR - 1) _
                .FormulaR1C1 = INP_INSERT_COLUMN_FORMULAR1C1 ' write formulas
        End With
    End With
    
    ' Reference the Copy and Destination sheets.
    Dim cws As Worksheet: Set cws = dwb.Sheets(COPY_SHEET_NAME)
    Dim dws As Worksheet: Set dws = dwb.Sheets(DST_SHEET_NAME)

    ' Reference the first entire row ranges (the same rows).
    Dim crg As Range: Set crg = cws.Rows(FIRST_ROWS)
    Dim drg As Range: Set drg = dws.Rows(FIRST_ROWS)
    
    ' Copy the first ranges (Copy to Destination).
    crg.Columns("AE").Copy Destination:=drg.Columns("B")
    drg.Columns("A").Value = crg.Columns("D").Value ' only values
    crg.Columns("Z").Copy Destination:=drg.Columns("C")
    
    ' Reference the second entire row ranges.
    Dim irg As Range: Set irg = iws.Rows(SECOND_ROWS)
    Set drg = dws.Cells(dws.Rows.Count, _
        DST_LAST_ROW_COLUMN).End(xlUp).Offset(1, 0) _
        .EntireRow.Resize(irg.Rows.Count)
    
    ' Copy the second ranges (Input to 'first available' row in Destination).
    irg.Columns("X").Copy Destination:=drg.Columns("B")
    drg.Columns("A").Value = irg.Columns("D").Value ' only values
    irg.Columns("AX").Copy Destination:=drg.Columns("C")
    
    ' Hide column 'C' in Destination.
    dws.Columns("C").Hidden = True
    
    Application.ScreenUpdating = True
    
    ' Inform.
    
    MsgBox "Import complete.", vbInformation, PROC_TITLE

End Sub