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

DSM 发表于 Dev

帝斯曼

我正在整理不同工作表的数据。

问题是将数据复制到目标文件时，所有数据都放在一列中。

下面的代码是发生问题的部分的片段。

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）的位置时，结果很好。

对于源文件，数据可能已放置在表中，所以这对为什么它最终位于目标文件的一列中有作用吗？

编辑：源图片。我可能已经找到了问题，但仍然需要解决方案。B和C列在此图中合并在一起。可以吗？

VBA皮特

您的宏对我来说很好。但是，您可以尝试使用.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），则通过将整个行向左移动来删除该列。

原始数据：