举个例子，我现在有一个excel工作薄，里面有两个sheet（我暂且命名为sheet1和sheet2）sheet1有数据；sheet2无数据，其中我想从sheet1中列头与sheet2列头相同的数据拷贝到sheet2下，如果对应不了的就不理会。。。不知道表达清楚没有！
小弟杠杠学习VBA，劳烦哪位大师帮我解决下这个问题，不甚感激！！！
人工核对编程，每一列写一条代码，例如，这个语句把sheet1表的A列拷贝到sheet2表的A列：
Sheets("sheet1").Range("A:A").Copy Sheets("sheet2").Range("A:A")
下面的语句同时拷屏A、B两列：
Sheets("sheet1").Range("A:B").Copy Sheets("sheet2").Range("A:B")
下面的语句把sheet1表的C列（单位名称）拷贝到sheet2表的D列：
Sheets("sheet1").Range("C:C").Copy Sheets("sheet2").Range("D:D")追问
Dim i, j
For i = 1 To Sheet2.UsedRange.Columns.Count
For j = 1 To Sheet1.UsedRange.Columns.Count
If Sheet1.Cells(1, i) = Sheet2.Cells(1, j) Then
Sheet1.Columns(i).Copy Sheet2.Columns(j)
Exit For
End If
Next j
Next i
End Sub追问
Sheets("sheet1").Range("A:A").Copy Sheets("sheet2").Range("A:A")
下面的语句同时拷屏A、B两列：
Sheets("sheet1").Range("A:B").Copy Sheets("sheet2").Range("A:B")
下面的语句把sheet1表的C列（单位名称）拷贝到sheet2表的D列：
Sheets("sheet1").Range("C:C").Copy Sheets("sheet2").Range("D:D")追问
人工核对太麻烦啊，数据量大这个还是不好操作哦
追答完全符合你的要求，测试通过的代码：
Sub xxx()Dim i, j
For i = 1 To Sheet2.UsedRange.Columns.Count
For j = 1 To Sheet1.UsedRange.Columns.Count
If Sheet1.Cells(1, i) = Sheet2.Cells(1, j) Then
Sheet1.Columns(i).Copy Sheet2.Columns(j)
Exit For
End If
Next j
Next i
End Sub追问
可以了，太谢谢了！
追答可用就行。麻烦点一下“采纳”～
追问 好像还是不行，我的实际例子是
结果是这样
不行是什么意思？能否拷屏，你的代码，执行的状态。
温馨提示：答案为网友推荐，仅供参考
第1个回答 2014-10-21
Sub findred()
Set xxx = Sheet1.UsedRange
For t1 = 1 To xxx.Rows.Count
For t2 = 1 To xxx.Columns.Count
If xxx(t1, t2).Font.ColorIndex = 3 Then
r = r + 1
Sheet2.Cells(r, 1).Resize(1, xxx.Columns.Count) = xxx.Rows(t1).Value
Exit For
End If
Next
Next
End Sub
--------------------------------------------------
根据补充, 再写以下一段程序:
Sub findempty()
Set xxx = Sheet1.[A3:A10000]
Set yy = Sheet2.[A3]
For Each xx In xxx
If Not IsEmpty(xx) Then
yy.Offset(r, 0) = xx
yy.Offset(r, 1) = xx.Offset(0, 3)
r = r + 1
End If
Next
End Sub
此程序差不多是VBA最基本及最低程度的代码, 亦容易明白及修改单元格的范围
Set xxx = Sheet1.UsedRange
For t1 = 1 To xxx.Rows.Count
For t2 = 1 To xxx.Columns.Count
If xxx(t1, t2).Font.ColorIndex = 3 Then
r = r + 1
Sheet2.Cells(r, 1).Resize(1, xxx.Columns.Count) = xxx.Rows(t1).Value
Exit For
End If
Next
Next
End Sub
--------------------------------------------------
根据补充, 再写以下一段程序:
Sub findempty()
Set xxx = Sheet1.[A3:A10000]
Set yy = Sheet2.[A3]
For Each xx In xxx
If Not IsEmpty(xx) Then
yy.Offset(r, 0) = xx
yy.Offset(r, 1) = xx.Offset(0, 3)
r = r + 1
End If
Next
End Sub
此程序差不多是VBA最基本及最低程度的代码, 亦容易明白及修改单元格的范围
