求修改代码复制指定单元格到

lagos · 发表于 2024-2-13 13:06

求修改代码复制指定单元格到粘贴位置同行的另一列，详情请看附件:

求修改代码.rar (13.47 KB, 下载次数: 10)

gwjkkkkk · 发表于 2024-2-13 13:16

Option Explicit
Sub TEST1()
Dim ar, strTxt$, i&, j&, r&

strTxt = Sheets(1).[H1].Value
r = Cells(Rows.Count, "D").End(xlUp).Row - 1
ReDim ar(1 To r, 0)
For i = 1 To UBound(ar)
ar(i, 0) = strTxt
Next i

Columns("B").Clear
[B2].Resize(UBound(ar)) = ar
Beep
End Sub

gwjkkkkk · 发表于 2024-2-13 13:18

................

无关岁月 · 发表于 2024-2-13 13:22

求修改代码.rar (13.47 KB, 下载次数: 4)

屏幕截图 2024-02-13 132108.png

ykcbf1100 · 发表于 2024-2-13 14:33

参与一下，新写一个。

ykcbf1100 · 发表于 2024-2-13 14:34

参与一下。。。

Sub ykcbf() '//2024.2.13
st = Me.[h1].Value2
r = Me.Cells(Rows.Count, 4).End(3).Row
arr = Me.Range("c2:f" & r)
For i = 1 To UBound(arr)
arr(i, 1) = st
Next
Me.Range("c2:f" & r) = arr
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 求修改代码复制指定单元格到

评分

评分

评分

评分