在保持列大小的同时将表从一个工作表复制到另一个工作表

将表格从一个工作表复制到另一个工作表,从原始工作表的列大小将被维护,因为新工作表已经有一个较小的列大小的表。

Dim i, lastRow lastRow = Sheets("Closed").Range("A" & Rows.Count).End(xlUp).Row For i = 1 To lastRow Sheets("Closed").Cells(i, "A").Copy Destination:=Sheets("Misc.Dashboard").Range("A" & Rows.Count).End(xlUp).Offset(1) Sheets("Closed").Cells(i, "B").Copy Destination:=Sheets("Misc.Dashboard").Range("B" & Rows.Count).End(xlUp).Offset(1) Sheets("Closed").Cells(i, "C").Copy Destination:=Sheets("Misc.Dashboard").Range("C" & Rows.Count).End(xlUp).Offset(1) Sheets("Closed").Cells(i, "D").Copy Destination:=Sheets("Misc.Dashboard").Range("D" & Rows.Count).End(xlUp).Offset(1) Sheets("Closed").Cells(i, "E").Copy Destination:=Sheets("Misc.Dashboard").Range("E" & Rows.Count).End(xlUp).Offset(1) Sheets("Closed").Cells(i, "F").Copy Destination:=Sheets("Misc.Dashboard").Range("F" & Rows.Count).End(xlUp).Offset(1) Sheets("Closed").Cells(i, "G").Copy Destination:=Sheets("Misc.Dashboard").Range("G" & Rows.Count).End(xlUp).Offset(1) Sheets("Closed").Cells(i, "H").Copy Destination:=Sheets("Misc.Dashboard").Range("H" & Rows.Count).End(xlUp).Offset(1) Sheets("Closed").Cells(i, "I").Copy Destination:=Sheets("Misc.Dashboard").Range("I" & Rows.Count).End(xlUp).Offset(1) Next i 

第一张表,要复制的表

第二张纸,目前下表粘贴表

因为你似乎从“Closed”工作表复制所有数据,并将其添加到“Misc.Dashboard”工作表的底部,而不是写入循环,如果数据量增加,变得非常慢,请尝试复制范围一气呵成。

 Dim lastRow As Long, lastColumn As Long With ThisWorkbook With .Worksheets("Closed") lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column .Range(.Cells(1, 1), .Cells(lastRow, lastColumn)).Copy End With With .Worksheets("Misc.Dashboard") .Range(.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0), .Cells(.Rows.Count, lastColumn).End(xlUp).Offset(1 + lastRow, 0)).PasteSpecial (xlPasteColumnWidths) .Range(.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0), .Cells(.Rows.Count, lastColumn).End(xlUp).Offset(1 + lastRow, 0)).PasteSpecial (xlPasteValues) End With End With Application.CutCopyMode = False