Копировать и вставить проблему с одного листа на другой

Question

У меня небольшая проблема.Я использую макрос, который сопоставляет данные другого листа.Проблема в том, что при копировании данных в файл назначения все данные помещаются в один столбец.Приведенный ниже код является просто фрагментом части, в которой возникает проблема в макросе.

        Workbooks.Open (Folderpath & Filename)
        Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
        Lastcolumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
        Range(Cells(2, 1), Cells(Lastrow, Lastcolumn)).Copy
        Application.DisplayAlerts = False
        ActiveWorkbook.Close
        erow = ThisIsAWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        ThisIsAWS.Paste Destination:=ThisIsAWS.Range(Cells(erow, 1), Cells(erow, Lastcolumn))
        Filename = Dir

Первоначально файл выглядит так.

После прохождения макроса он заканчивается следующим образом.

Когда я делаю это вручную, где я копирую (Ctrl+ c) и вставьте (ctrl + v), используя те же данные, все получится хорошо.

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

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

РЕДАКТИРОВАТЬ: Исходное изображение.Я мог бы найти проблему, но все еще нуждался в решении.Столбцы B и C объединены на этом рисунке.Может ли это быть так?

Answer 1

Закрыто слишком рано

  With Workbooks.Open(Folderpath & Filename).ActiveSheet
    Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
    Lastcolumn = .Cells(2, .Columns.Count).End(xlToLeft).Column
    erow = ThisIsAWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    .Range(.Cells(2, 1), .Cells(Lastrow, Lastcolumn)).Copy _
        Destination:=ThisIsAWS.Cells(erow, 1)
    .Parent.Close False
  End With
  Filename = Dir

Answer 2

У меня твой макрос работает нормально.Однако вы можете попытаться установить диапазоны равными, используя .value вместо .copy:

Dim to_rng as Range
Dim rng_loop as Range

Workbooks.Open (Folderpath & Filename)
    Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Lastcolumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
    Application.DisplayAlerts = False
    erow = ThisIsAWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Set to_rng = ThisIsAWS.Range(ThisIsAWS.Cells(erow, 1), ThisIsAWS.Cells(erow + Lastrow - 2, Lastcolumn))
    to_rng.value = ActiveSheet.range(ActiveSheet.cells(2,1), ActiveSheet.cells(Lastrow, Lastcolumn)).value

    For loop1 = Lastcolumn To 1 Step -1
        Set rng_loop = ThisIsAWS.Range(ThisIsAWS.Cells(erow, loop1), ThisIsAWS.Cells((erow + Lastrow - 2), loop1))
        If WorksheetFunction.CountA(rng_loop) = 0 Then
            rng_loop.Delete shift:=xlToLeft
        End If
    Next loop1

    ActiveWorkbook.Close
    Filename = Dir

Цикл перемещается назад (шаг -1) через каждый столбец в добавляемом диапазоне, и если все ячейки встолбец диапазона пуст (CountA = 0), затем он удаляет столбец, сдвигая всю строку влево.

Исходные данные:

Данные добавлены в другой файл: