Excel宏批量转置并删除空格

效果预览

《Excel宏批量转置并删除空格》
《Excel宏批量转置并删除空格》
《Excel宏批量转置并删除空格》

VBA代码

Sub 转置并删除空格()
'
' 转置 宏
' 快捷键: Ctrl+Shift+U

'   设置屏幕不滚动
    Application.ScreenUpdating = False
    Range("B1").Select
    
    ActiveCell.Range("A1:A6").Select
    
    Do While ActiveCell <> ""
        Selection.Copy
        ActiveCell.Offset(0, 3).Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        ActiveCell.Offset(6, -3).Range("A1:A6").Select
        Application.CutCopyMode = False
   Loop
  
  Columns("E:J").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp
    Range("E1:J1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1:A6").Select
    Selection.Copy
    Range("E1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub
    原文作者:谷曰十鑫
    原文地址: https://blog.csdn.net/weixin_43636302/article/details/103054650
    本文转自网络文章,转载此文章仅为分享知识,如有侵权,请联系博主进行删除。
点赞