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

Question

将sheet1蓝色字体内容提取到sheet2格式。当内容改变点击按钮可以再次将内容提取到sheet2并以此排列。

Answer 1

答：确保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