<em>VBA</em>代码：将数据复制到另一表中符合条件的行-excel vba 表格复制,e

代码如抄下。百详见附件度

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Application.Intersect(Range("A1"), Target) Is Nothing And Target.Count = 1 Then
      Dim N&
      N = Val(Target)
      If N > 0 And N <= Cells.Columns.Count Then
         Sheet1.Columns(N).Copy [A1]
      Else
         Columns(1).ClearContents
      End If
   End If
End Sub

右击要填金额的表单（就是输抄入张三和金额的表单）袭，查看代码，将以下代码复制进去即可实现知
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Target.Row = 3 And Target.Column = 3 Then
If Cells(3, 2) = "" Then
MsgBox "B3没有填名字!"
Exit Sub
End If
mz = Cells(3, 2)
a = Sheets("名字表").[a65536].End(xlUp).Row '你要操作的表格,表明道自己改
ar = Sheets("名字表").Range("a1:a" & a)
For i = 2 To a
If ar(i, 1) = mz Then
k = i
i = a
End If
Next
b = Sheets("名字表").Cells(k, 255).End(xlToLeft).Column
Sheets("名字表").Cells(k, b + 1) = Target.Value
End If
End If
End Sub
这样就行了,在"订单"的D2010面页上画一个文本框,输入"执行".然后在当前工作表内录制一个"执行"宏,如下:

Sub 执行()

Workbooks.Open Filename:="X:\\报告.xls"

Windows("D2010").Activate

Columns("C:G").Select

Application.CutCopyMode = False

Selection.Copy

Windows("报告.xls").Activate

Sheets("D2010").Select

Columns("A:E").Select

ActiveSheet.Paste

Range("A1").Select

Application.CutCopyMode = False

ActiveWorkbook.Save

ActiveWindow.Close

Range("A1").Select
End Sub

选中画好的zhidao文本框,右键,指定宏,选刚录好的上面那个"执行"宏,这样就完全实现你的要求.

说明:宏内专第一行的的"X:\\报告.xls"请把它改为你的报告.XLS文件实际路径即可.

建议:能够用宏来做的,不需要用VB按钮.如果一定要用,把宏内的代码复属制到按钮代码内,稍作修改即行.

以下代码你试试
sheet1 是判断的e68a84e8a2ade79fa5e98193362工作表 改成你自己的
sheet2 是粘贴的工作表 改成你自己的
------代码开始-------
Sub 判断复制()
Dim a%, b, c
Do
b = b + 1 '行数累加
If Sheets("Sheet1").Cells(b, 1) = "" Then Exit Do '判断单元格是否为空，为空时结束代码运行 也可以改成行数多少时结束如:if B>100 then exit sub
a = Cells(b, 1).Font.ColorIndex '获取字体颜色
If a = 3 Then '判断字体颜色是否为红色（VBA中红色是3/excel中RGB(255,0,0)是红色）
Sheets("Sheet1").Select '选中工作表
Rows(b & ":" & b).Select '判断正确选择该行
Selection.Copy '复制
Sheets("sheet2").Select '选择sheet2工作表（sheet2可以更改为其它工作表）
Range("A65536").Select
Selection.End(xlUp).Select
c = ActiveCell.Row + 1
Range("A" & c).Select '选中最后使用单元格的下一个A列的值
ActiveSheet.Paste '粘贴
Sheets("Sheet1").Select '选中判断条件的单元格
End If
Loop
Sheets("Sheet2").Select
Application.CutCopyMode = False
End Sub
------代码结束-----------

本文标签：excel表格vba是什么(3)excel vba 表格复制(1)