请教用VB自动根据EXCLE表建新表的代码

追问：您的答案比较接近我的要求，我还想问一下，如何让程序自动读取行数，并自动生成？？比如原始表上客户下面如果是3，则程序自动生成三行，是4，就自动生成4行，谢谢

其他：'菜单：工程->引用Microsoft Excel 11.0
Private Sub Command1_Click()
    Dim XlApp As New Excel.Application
    Dim XLWorkBook As New Excel.Workbook
    Dim XLWorkSheet As New Excel.Worksheet
    Dim XLWorkSheet2 As New Excel.Worksheet
    Set XLWorkBook = XlApp.Workbooks.Open(App.Path & "\1.xls")
    Set XLWorkSheet = XLWorkBook.Sheets(1)
    Set XLWorkSheet2 = XLWorkBook.Sheets.Add
    XLWorkSheet2.Cells(1, 1) = XLWorkSheet.Cells(1, 1)
    XLWorkSheet2.Cells(1, 2) = XLWorkSheet.Cells(1, 2)
    x = 0
    For j = 2 To XLWorkSheet.UsedRange.Rows.Count
        For i = 1 To Val(XLWorkSheet.Cells(j, 1))
            XLWorkSheet2.Cells(x + i + 1, 2) = XLWorkSheet.Cells(j, 2)
        Next i
        x = x + Val(XLWorkSheet.Cells(j, 1))
    Next j
    XLWorkBook.Save
    XlApp.Quit
End Sub 我做了个从Sheet1生到Sheet2的,你可以参考,如果你的数据量大,你还需要对Sheet1里面的行数作个定义~
 
Sub Macro7() '我的例子没有新建BOOK,只是把内容从Sheet1生到了Sheet2里面
    Sheets("Sheet1").Select
    Range("A1:B1").Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
    
N = Sheets("sheet1").Range("A2") '5
M = N + 1
Sheets("sheet1").Select
Range("B2").Copy
Sheets("sheet2").Select
Range("B2:B" & M).Select
ActiveSheet.Paste
 
Dim H As Long, NN As Long, R As Long
For RR = 3 To 4 'RR是表示sheet1里面的行数,如果你有很多行,你就要先定义你的行数
ActiveWorkbook.Sheets("Sheet2").Select
H = Sheets("Sheet2").Range("B1").End(xlDown).Row 'H1=6
HH = H + 1 'HH1=7
NN = ActiveWorkbook.Sheets("Sheet1").Range("A" & RR) 'N1=3
ActiveWorkbook.Sheets("Sheet1").Select
Range("B" & RR).Copy
ActiveWorkbook.Sheets("Sheet2").Select
Range(Cells(HH, 2), Cells(H + NN, 2)).Select
ActiveSheet.Paste
Next
  
  End Sub 

上一个：VB DirListBox的问题
下一个：vb DTPicker两天时间差