從一個工作表復制並粘貼到另一個

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) 時，結果很好。

對於源文件，數據可能已經放在一個表中，那么這會影響它為什么最終出現在目標文件的一列中嗎？

編輯：源圖片。 我可能已經發現了問題，但仍然需要解決方案。 在此圖片中，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）通過添加范圍中的每一列，如果范圍列中的所有單元格都為空（CountA = 0），則它通過將整行向左移動來刪除該列。

原始數據：

添加到其他文件的數據：

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