如何向下复制单元格而不覆盖下面的单元格？

https://dl.dropbox.com/u/3327208/Excel/copydown.xlsx

如果您无法查看收存箱，这是表单。

这是工作簿。 我想要做的是向3M展示公司名称，将公司名称复制到A栏中显示Total的位置，然后对下一家公司进行相同操作。

我如何在Excel VBA中执行此操作？ 我知道我可以使用最后一行，但这不完全是我相信的最好的方式，因为原始版本将有超过300个不同的公司。

这是我现在使用的原始代码。 没有额外的位添加。

选项显式

Sub Import() Dim lastrow As Long Dim wsIMP As Worksheet 'Import Dim wsTOT As Worksheet 'Total Dim wsSHI As Worksheet 'Shipped Dim wsEST As Worksheet 'Estimate Dim wsISS As Worksheet 'Issued Dim Shift As Range Set wsIMP = Sheets("Import") Set wsTOT = Sheets("Total") Set wsSHI = Sheets("Shipped") Set wsEST = Sheets("Estimate") Set wsISS = Sheets("Issued") With wsIMP wsIMP.Range("E6").Cut wsIMP.Range("E5") wsIMP.Range("B7:G7").Delete xlShiftUp End Sub 

Answer 1

马特，几个月前我有一个很好的function，但我忘了复制到我的图书馆。 不过，我已经做了一个很好的模拟我以前的东西。 （我使用它来填补数据透视表中的某些原因或其他）。

无论如何，在这里。 您可能需要调整以满足您的具体需求，而且我并不是说现在不会有任何错误，但这应该是一个很好的开始。

编辑 =我已经更新了我的代码post，以融入到你的使你更容易。

  Sub Import() Dim lastrow As Long Dim wsIMP As Worksheet, wsTOT As Worksheet 'Total Dim wsSHI As Worksheet, wsEST As Worksheet 'Estimate Dim wsISS As Worksheet, Shift As Range Set wsIMP = Sheets("Import") Set wsTOT = Sheets("Total") Set wsSHI = Sheets("Shipped") Set wsEST = Sheets("Estimate") Set wsISS = Sheets("Issued") With wsIMP .Range("E6").Cut .Range("E5") .Range("B7:G7").Delete xlShiftUp Call FillDown(.Range("A1"), "B") '-> more code here End With End Sub Sub FillDown(begRng As Range, col As String) Dim rowLast As Long, rngStart As Range, rngEnd As Range rowLast = Range(col & Rows.Count).End(xlUp).Row Set rngStart = begRng Do If rngStart.End(xlDown).Row < rowLast Then Set rngEnd = rngStart.End(xlDown).Offset(-1) Else Set rngEnd = Cells(rowLast, rngStart.Column) End If Range(rngStart, rngEnd).FillDown Set rngStart = rngStart.End(xlDown) Loop Until rngStart.Row = rowLast End Sub enter code here 

Answer 2

只要没有公式你不想覆盖…

编辑 – 更新设置原始范围的基础B列结束

 Sub Macro1() Dim sht as WorkSheet Set sht = ActiveSheet With sht.Range(sht.Range("A7"), _ sht.Cells(Rows.Count, 2).End(xlUp).Offset(0, -1)) .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" .Value = .Value End With End Sub