|
新手急求高手指点一个关于公式自动填充问题:
实现
1)点击Marco 后,可以把工作表"MTDsales.XLS"上的数据自动复制更新到工作表("PRC order controlworkingfile.xlsx")sheet("MTD sales")中.
2) r = 工作表("PRC order controlworkingfile.xlsx")sheet("MTD sales")中的C12:C列往下有值的列的count值
2).工作表("PRC order controlworkingfile.xlsx")sheet (MTD sales by plant)中 "A1:B1"的公式自动往下填充到 "A &r : B &r"
如下是刚编的程序, 涂红色字体中的 r 值运算不出来,不知道为什么? 求高手帮忙. 非常感谢!!!
Sub PRCordcontrol()
On Error Resume Next
Dim myapp2 As Object
Dim wkb1 As Object, wkb3 As Object
Dim r As Long, j As Integer
Set myapp = CreateObject("Excel.Application")
Set wkb1 = myapp.Workbooks.Open("C:\Documents and Settings\10172999\Desktop\MTDsales.XLS") '打开工作表"MTDsales.xls"
Set wkb3 = myapp.Workbooks.Open("C:\Documents and Settings\10172999\Desktop\PRC order controlworkingfile.xlsx") ''打开工作表 "PRC order controlworkingfile.xlsx"
wkb1.Sheets("MTDsales").Cells.Copy wkb3.Sheets("MTD sales").Range("A1") '工作表"MTDsales.xls"中的数据(整个sheet内容)复制到工作表"PRC order controlworkingfile.xlsx"中的sheet("MTD sales")
Application.CutCopyMode = True
wkb3.Sheets("MTD sales").Activate '激活 wkb3
wkb3.Sheets("MTD sales").Range("C12:C" & Range("c1048576").End(xlUp)).Select ' 选择wkb3工作表中的 C12至C列有数据的最后一行
r = wkb3.Sheets("MTD sales").Selection.Rows.Count 'C12至C列有数据的最后一行付值给 r
wkb3.Sheets("MTD sales total").Activate ' 激活wkb3.Sheets("MTD sales total")
wkb3.Sheets("MTD sales total").Range("A1:C1").Copy '复制wkb3.Sheets("MTD sales total")"A1:C1" (主要为复制公式)
wkb3.Sheets("MTD sales total").Range("A2:H" & r).PasteSpecial -4123 '把复制的"A1:C1"的公式填充到 A2:H2列 往下至 最后一行有数值的单元格 (其中的r值会经常更新).
wkb3.Sheets("MTD sales total").Range("A2:H" & r).PasteSpecial -4122 '把复制的"A1:C1"的格式填充到 A2:H2列 往下至 最后一行有数值的单元格 (其中的r值会经常更新).
wkb3.SaveAs Filename:="C:\Documents and Settings\10172999\Desktop\Macro\PRC order control\" & "PRC Order Control" & Format(Now(), "YYYYMMDDHH") & " .xlsx" '保存单元格
wkb1.Close 0
wkb2.Close 0
wkb3.Close 0
Set wkb1 = Nothing
Set wkb2 = Nothing
Set wkb3 = Nothing
Sub test()
Set myapp = CreateObject("Excel.Application")
Set wkb1 = myapp.Workbooks.Open(ThisWorkbook.Path & "\MTDsales.XLS")
Set wkb3 = myapp.Workbooks.Open(ThisWorkbook.Path & "\PRC order controlworkingfile.xlsx")
wkb1.Sheets("MTDsales").Cells.Copy wkb3.Sheets("MTD sales").Range("A1")
r = wkb3.Sheets("MTD sales").Range("c1048576").End(xlUp).Row - 11
With wkb3.Sheets("MTD sales by plant")
.Range("A1:B1").AutoFill Destination:=.Range("A1:B" & r), Type:=xlFillDefault
End With
wkb3.SaveAs Filename:=ThisWorkbook.Path & "PRC Order Control" & Format(Now(), "YYYYMMDDHH") & " .xlsx"
wkb1.Close 0
wkb3.Close 0
Set wkb1 = Nothing
Set wkb3 = Nothing
Set myapp2 = Nothing
End Sub
|
|