How do I output the result on a different sheet?

[richard cheung]

Here is the code for the Excel VBA
---

Sub CopyData()
'Updateby Extendoffice
Dim xRow As Long
Dim VInSertNum As Variant
xRow = 1
Application.ScreenUpdating = False
Do While (Cells(xRow, "A") <> "")
VInSertNum = Cells(xRow, "B")
If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
Range(Cells(xRow, "A"), Cells(xRow, "B")).Copy
Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "B")).Select
Selection.Insert Shift:=xlDown
xRow = xRow + VInSertNum - 1
End If
xRow = xRow + 1
Loop
Application.ScreenUpdating = False
End Sub

 

[footoo]

Copy the original data to a new sheet then run your code.

 

[richard cheung]

I meant, how do i automatically copy from "Sheet1" and paste in "sheet2" with 1 click of a button? Currently it only able to paste in the same spreadsheet

 

[veyselemre]

Sub CopyData()
    Dim s1 As Worksheet, s2 As Worksheet, _
        endRow&, rep%
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    endRow = 1
    For i = 1 To s1.Cells(Rows.Count, 1).End(3).Row
        rep = IIf(IsNumeric(s1.Cells(i, 2).Value), s1.Cells(i, 2).Value, 1)
        s1.Cells(i, 1).Resize(, 2).Copy s2.Cells(endRow, 1).Resize(rep, 2)
        endRow = endRow + rep
    Next i
End Sub

 

[footoo]

I meant, how do i automatically copy from "Sheet1" and paste in "sheet2" with 1 click of a button? Currently it only able to paste in the same spreadsheet

Put code at the start of your macro to paste the data from Sheet1 to Sheet2 (get the code from the macro recorder).

 

[sunwave]

Sub CopyData()
    Dim s1 As Worksheet, s2 As Worksheet, _
        endRow&, rep%
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    endRow = 1
    For i = 1 To s1.Cells(Rows.Count, 1).End(3).Row
        rep = IIf(IsNumeric(s1.Cells(i, 2).Value), s1.Cells(i, 2).Value, 1)
        s1.Cells(i, 1).Resize(, 2).Copy s2.Cells(endRow, 1).Resize(rep, 2)
        endRow = endRow + rep
    Next i
End Sub

Works for me, thank you!

Sub CopyData()
    Dim s1 As Worksheet, s2 As Worksheet, _
        endRow&, rep%
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    endRow = 1
    For i = 1 To s1.Cells(Rows.Count, 1).End(3).Row
        rep = IIf(IsNumeric(s1.Cells(i, 2).Value), s1.Cells(i, 2).Value, 1)
        s1.Cells(i, 1).Resize(, 2).Copy s2.Cells(endRow, 1).Resize(rep, 2)
        endRow = endRow + rep
    Next i
End Sub
[/QUOTE]