求<em>excel</em>批量粘贴的宏代码-excel 宏 复制,excel启用宏后无法复制

在工作表名称上点击鼠标右键选查zd看代码,粘贴下面代码到弹出的版VBA编辑窗口,关闭VBA编辑窗口,返回工作表按ALT+F8 选中执行权
Sub aa()
endrow = Range("A65536").End(xlUp).Row
endcol = Range("iv1").End(xlToLeft).Column
Set rng = Range("A1:B" & endrow)
irows = endrow
For i = 5 To endcol Step 2
Range("A" & irows + 1).Resize(endrow, 2).Value = rng.Value
Range("C" & irows + 1).Resize(endrow, 2).Value = Range(Cells(1, i), Cells(endrow, i + 1)).Value
Range(Cells(1, i), Cells(endrow, i + 1)) = ""
irows = irows + endrow
Next
End Sub

这个原公式所在的表里面，激636f7079e799bee5baa6e997aee7ad94337活公式所在的表，运行代码看看。

Sub AAA()
    Dim Spath As String, Path As String, Sh As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.ShowWindowsInTaskbar = False
    Set Sh = Worksheets(1)
    Path = ThisWorkbook.Path
    Spath = Dir(Path & "*.XLS*")
    Do Until Spath = ""
        If Spath = ThisWorkbook.Name Then Spath = Dir
        With Workbooks.Open(Path & Spath)
            .Worksheets(1).Columns("H").FormulaLocal = Sh.Columns("H").FormulaLocal
            .Worksheets(1).Columns("J").FormulaLocal = Sh.Columns("J").FormulaLocal
            .Close True
        End With
        Spath = Dir
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.ShowWindowsInTaskbar = True
End Sub

set orirg=range("l13")'基准单元格
application.calculation = xlmanual'因为表内公式复多，为加快处理速度，暂停计制算
for each bb in range("i3:al3")'循环检知查非空区域
if len(bb)>0 then
rowpt=worksheetfunction.counta(range("l14:l50000"))'输出行定位
bb.offset(-1,0).resize(6,1).copy
orirg.offset(rowpt,9).pastespecial paste:=xlvalues, transpose:=true'转置粘贴数道值
orirg.offset(rowpt,0).resize(1,7).value=range("b8:h8").offset(bb.value,1).value'直接赋值
endif
next i
application.calculation = xlautomatic
set orirg=nothing

核心代码就一句话，前面添加SUB、后面添加END SUB共三行：
SUB 宏1()
SELECTION.VALUE=SHEET2.RANGE("A1").VALUE

END SUB