0

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

This is the sheet if you can't view dropbox. enter image description here

This is the workbook. What I'm looking to do is where it shows 3M, copy the title of the company down to where it shows Total in Column A, and do the same with the next company.

How do I do this in Excel VBA? I know I can use the last row, but it's not exactly the best way for this I believe, because the original version will have over 300 different companies.

Here is the original code I am using for now. Without the extra bits added in.

Option Explicit

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
4

2 回答 2

1

只要没有您不想覆盖的公式...

编辑- 更新以设置基于 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
于 2012-08-24T15:49:24.950 回答
1

马特，几个月前我有一个很棒的功能，但我忘了复制到我的图书馆。然而，我已经做了一个很好的模型来模拟我以前的东西。（出于某种原因，我使用它来填写数据透视表中的条目）。

不管怎样，就在这里。您可能需要对其进行调整以满足您的确切需求，我并不是说它目前不容易出现任何错误，但这应该是一个很好的开始。

编辑=我已经更新了我的代码帖子以集成到您的代码中，以使您更轻松。 

    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
于 2012-08-24T15:13:34.040 回答