<em>excel</em>中用<em>vba</em>实现提取某一工作

Sub 复制百()

Dim i&, a%

i = Range("d5").End(xlDown).Row

Range("f:f").ClearContents

For a = 5 To i

If Cells(a, 5).Value <> "" Then

Else: Cells(a, 4).Copy Cells(a - 2, 6)

End If

Next

End Sub

没太理解度你版的意思。权

把你的表发给我研究一下，完成后再发给你！
'在下面知的代码中，tf 是由 FileSystemObject 的 OpenTextFile 方法返回的道 TextStream 对象：
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim fs,tf,str
Set fs = CreateObject("Scripting.FileSystemObject")
Set tf = fs.OpenTextFile("c:\testfile.txt", ForReading, TristateFalse)
'跳到指定版字符权数，这里指定10个字符。
tf.Skip(10)
'把指定数量的字符读到字符串，这里指定20个字符。
str = tf.Read(20)
tf.Close

代码如下：
请保存成名为BOOK的97-2003格式文件
并把所7a64e59b9ee7ad94364有的数据文件，放到与这个文件同一个文件夹中，再执行程序
Sub main()
f = Dir(ThisWorkbook.Path & "\" & "*.xls*")
Do While f <> ""
If f = "BOOK.xls" Then GoTo eee
Workbooks.Open ThisWorkbook.Path & "\" & f
arr = ActiveWorkbook.Sheets(1).Range("A1").CurrentRegion
For i = 2 To UBound(arr)
If ActiveWorkbook.Sheets(1).Cells(i, "D") = "2000" Then '这里是提取2000年数据，如果是其他年份，将2000更改
k = ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Row + 1
ActiveWorkbook.Sheets(1).Rows(i).Copy ThisWorkbook.Sheets(1).Rows(k)
End If
Next i
Workbooks(f).Close
eee:
f = Dir
Loop
End Sub