excel技巧

160 阅读1分钟
//删除excel每个工作表的几行(可以排除某个工作表)
Sub DeleteRowsExceptFirstSheet()    Dim ws As Worksheet    Dim i As Integer        For Each ws In ThisWorkbook.Worksheets        If ws.Index <> 1 Then ' 排除第一个工作表            For i = 1 To 5 ' 删除前两行数据,如果需要删除不同行数,可以修改这里的数字                ws.Rows(1).Delete            Next i        End If    Next wsEnd Sub
//合并一个excel中的所有工作表Sub 合并所有工作表()    Dim ws As Worksheet    Dim wsMerge As Worksheet    ' 创建一个新的工作表用于合并数据    Set wsMerge = ThisWorkbook.Worksheets.Add    ' 循环遍历每个工作表    For Each ws In ThisWorkbook.Worksheets        ' 跳过新创建的工作表        If ws.Name <> wsMerge.Name Then            ' 查找最后一行            lastRow = ws.Cells(ws.rows.Count, "A").End(xlUp).row            ' 将数据复制到合并工作表            ws.Range("A1:ZZ" & lastRow).Copy Destination:=wsMerge.Cells(wsMerge.rows.Count, "A").End(xlUp).Offset(1)        End If    Next wsEnd Sub
合并多个excel的第一个sheet
Sub 合并工作表()
    Dim wbDst As Workbook
    Dim wbSrc As Workbook
    Dim wsSrc As Worksheet
    Dim wsDst As Worksheet
    Dim MyPath As String
    Dim strExtension As String
    Dim strFilename As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wbDst = ThisWorkbook
    MyPath = "D:\Work\17 松江残联\008 台账数据需求\康复\两项补贴 - 输出版本\KN" ' 修改为存放 Excel 文件的文件夹路径

    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    strExtension = "*.xls*"
    strFilename = Dir(MyPath & strExtension)

    Do While strFilename <> ""
        Set wbSrc = Workbooks.Open(Filename:=MyPath & strFilename)
        Set wsSrc = wbSrc.Worksheets(1)
        Set wsDst = wbDst.Worksheets.Add(After:=wbDst.Sheets(wbDst.Sheets.Count))
        wsDst.Name = Left(strFilename, Len(strFilename) - 4)
        wsSrc.UsedRange.Copy wsDst.Range("A1")
        wbSrc.Close False
        strFilename = Dir()
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

删除excel中所有工作表的最后两行
Sub DeleteLastTwoRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    
    For Each ws In ThisWorkbook.Worksheets
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        If lastRow > 1 Then
            ws.Rows(lastRow - 1 & ":" & lastRow).Delete
        End If
    Next ws
End Sub