用单元引用填充许多公式的快速方法

我有一个大的数据电子表格，我正在写一个macros的VBA来填充另一个选项卡，复制与单元格引用不是值的表（我意识到这很奇怪，但这是我已经被要求做）。 我在这里的代码工作，但它需要永远。 我认为必须有一个更快的方式，因为用这个好的控制cv只需要不到一秒的时间。

Public Sub PopulateSheet() Dim inputSheet As Worksheet Dim outputSheet As Worksheet Dim rowCounter As Long Dim columnCounter As Long Dim maxRow As Long Set inputSheet = Sheets("inputSheet") Set outputSheet = Sheets("outputSheet") maxRow = inputSheet.Cells(1048576, 1).End(xlUp).Row With outputSheet For columnCounter = 1 To 6 For rowCounter = 1 To maxRow .Cells(rowCounter, columnCounter).Formula = "=" & "'inputSheet'!" & Cells(rowCounter, columnCounter).Address Next rowCounter Next columnCounter End With 

编辑：我已经closuresscreenupdating并将计算设置为手动。

Answer 1

 Set inputSheet = Sheets("inputSheet") Set outputSheet = Sheets("outputSheet") maxRow = inputSheet.Cells(1048576, 1).End(xlUp).Row inputsheet.Range("A1").resize(maxRow, 6).copy With outputSheet .activate .range("A1").select .paste Link:=true End With 

Answer 2

你可以试试这个：

 Public Sub PopulateSheet() Dim inputSheet As Worksheet Dim outputSheet As Worksheet Dim rowCounter As Long Dim columnCounter As Long Dim maxRow As Long Set inputSheet = Sheets("inputSheet") Set outputSheet = Sheets("outputSheet") maxRow = inputSheet.Cells(1048576, 1).End(xlUp).Row With outputSheet For columnCounter = 1 To 6 .Cells(1, columnCounter).Formula = "=" & "'inputSheet'!" & Cells(1, columnCounter).Address(False,False) .Range(.Cells(1, columnCounter), .Cells(maxRow, columnCounter)).FillDown Next columnCounter End With