excel如何用宏把表中每一行复制到每个新建的工作表中
1个回答
展开全部
假设你用的工作表是Sheet1
Sub Macro1()
'
' Macro1 Macro
Dim I As Integer
Dim Zname As String
Zname = ActiveSheet.UsedRange.Address
For I = 1 To Val(Mid(Zname, InStr(InStr(Zname, ":") + 2, Zname, "$") + 1, 6))
Zname = Format(I)
Rows(Zname & ":" & Zname).Copy
If Not WorksheetExists(Zname) Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Zname
End If
Sheets(Zname).Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select '假设你用的工作表Sheet1
Next
End Sub
Function WorksheetExists(ByVal SheetName As String) As Boolean
Dim sName As String
On Error GoTo err1
sName = Worksheets(SheetName).Name
WorksheetExists = True
Exit Function
err1:
WorksheetExists = False
End Function
Sub Macro1()
'
' Macro1 Macro
Dim I As Integer
Dim Zname As String
Zname = ActiveSheet.UsedRange.Address
For I = 1 To Val(Mid(Zname, InStr(InStr(Zname, ":") + 2, Zname, "$") + 1, 6))
Zname = Format(I)
Rows(Zname & ":" & Zname).Copy
If Not WorksheetExists(Zname) Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Zname
End If
Sheets(Zname).Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select '假设你用的工作表Sheet1
Next
End Sub
Function WorksheetExists(ByVal SheetName As String) As Boolean
Dim sName As String
On Error GoTo err1
sName = Worksheets(SheetName).Name
WorksheetExists = True
Exit Function
err1:
WorksheetExists = False
End Function
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询