如图,用excel VBA设置一个按钮,将表格中指定内容提取到sheet2,内容改变点击按钮可以在此提取,谢谢

将sheet1蓝色字体内容提取到sheet2格式。当内容改变点击按钮可以再次将内容提取到sheet2并以此排列。... 将sheet1蓝色字体内容提取到sheet2格式。当内容改变点击按钮可以再次将内容提取到sheet2并以此排列。 展开
 我来答
mzz9060
2018-05-02 · TA获得超过1324个赞
知道小有建树答主
回答量:773
采纳率:84%
帮助的人:195万
展开全部

答:确保Sheet1为活动工作表时,运行下面代码。

Sub Demo()
    Dim MyRng As Range
    Dim DesRng As Range

    Set MyRng = Range("B6:G10")
    Set DesRng = Sheets("Sheet2").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0)
    MyRng.Copy
    With DesRng
        .PasteSpecial xlPasteValues
        .Offset(0, -3).Resize(MyRng.Rows.Count, 1) = Range("F1")
        .Offset(0, -2).Resize(MyRng.Rows.Count, 1) = Range("B1")
        .Offset(0, -1).Resize(MyRng.Rows.Count, 1) = Range("B2")
    End With
    Application.CutCopyMode = False
End Sub
追问
感谢,可以用。完美。
追答
Sub Demo()
Dim Cell As Range
Dim DesRng As Range

Set DesRng = Sheets("Sheet2").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0)
For Each Cell In Range("B6:B10")
If Not IsEmpty(Cell) Then
Cell.Resize(1, 6).Copy
With DesRng
.PasteSpecial xlPasteValues
.Offset(0, -3) = Range("F1")
.Offset(0, -2) = Range("B1")
.Offset(0, -1) = Range("B2")
End With
Set DesRng = DesRng.Offset(1, 0)
End If
Next
Application.CutCopyMode = False
End Sub
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式