将问题从一个工作表复制并粘贴到另一个工作表

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

您的宏对我来说很好。但是，您可以尝试使用.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），如果range列中的所有单元格都为空（CountA = 0），则它将整个行向左移动来删除该列。 / p>

原始数据：

数据已添加到其他文件：

Answer 2

关闭时间过早

  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