VBA80集第12集作业上交贴：非空行

twandou · 发表于 2011-8-21 22:24

Sub test1()
Application.Intersect(Columns(1), Range("b:d").SpecialCells(xlCellTypeConstants).EntireRow) = 1
End Sub
Sub test2()
Dim wb As Workbook, x As Integer
Application.ScreenUpdating = False
Set wb = Workbooks.Open(ThisWorkbook.Path & "/A.xls")
For x = 1 To wb.Sheets.Count
With ThisWorkbook.Sheets("第2题")
If x = 1 Then
wb.Sheets(x).UsedRange.Copy .Range("a1")
Else
wb.Sheets(x).UsedRange.Offset(1, 0).Copy .Range("a65536").End(xlUp).Offset(1, 0)
End If
End With
Next x
wb.Close
Application.ScreenUpdating = True
End Sub

复制代码

twandou · 发表于 2011-8-21 22:25

Sub test1()
Application.Intersect(Columns(1), Range("b:d").SpecialCells(xlCellTypeConstants).EntireRow) = 1
End Sub
Sub test2()
Dim wb As Workbook, x As Integer
Application.ScreenUpdating = False
Set wb = Workbooks.Open(ThisWorkbook.Path & "/A.xls")
For x = 1 To wb.Sheets.Count
With ThisWorkbook.Sheets("第2题")
If x = 1 Then
wb.Sheets(x).UsedRange.Copy .Range("a1")
Else
wb.Sheets(x).UsedRange.Offset(1, 0).Copy .Range("a65536").End(xlUp).Offset(1, 0)
End If
End With
Next x
wb.Close
Application.ScreenUpdating = True
End Sub

复制代码

wuhuisheng · 发表于 2011-8-24 21:30

学习学习！

110413234 · 发表于 2011-8-30 20:40

aaaaaaaaaaaaaaaaaaaaaaaa

scallionchou · 发表于 2011-9-8 10:36

看看..........

dbidb · 发表于 2011-9-8 23:32

提示: 作者被禁止或删除内容自动屏蔽

wcuwkq · 发表于 2011-9-9 09:57

呜呜，没钱下把

wcuwkq · 发表于 2011-9-9 09:57

发现回帖也是有金币的

wcuwkq · 发表于 2011-9-9 09:57

不好意思，再回两句我就够下一集了

杨帆远航 · 发表于 2011-9-9 10:58

顶一下,我还以为是过关答案呢

		自动登录	找回密码
密码			注册

dbidb dbidb 当前离线积分 214 IP卡狗仔卡	发表于 2011-9-8 23:32 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽
dbidb dbidb 当前离线积分 214 IP卡狗仔卡
	回复使用道具举报显身卡

RE: VBA80集第12集作业上交贴：非空行