英文:
Copying Column to next one
问题
我的目标是创建一个宏，将整个列 R 复制并粘贴到下一列 S。当我再次使用按钮时，列 R 将被复制，并应粘贴到列 T。
Sub CopyPaste()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet1")
copySheet.Range("R:R").Copy
pasteSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
但是当我使用宏时，列会被复制，但不会移动到下一列，永远不会粘贴到列 R。
英文:
My Goal is to get a Macro that copies the whole Column R and pastes it into the next Column S. When i use the button again, the column R gets copied and it should be pasted into the column T.
Sub CopyPaste()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet1")
copySheet.Range("R:R").Copy
pasteSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
But when I use the macro, the column gets copied, but it doesn't move to the next column and never gets pasted into the column R.
答案1
得分: 1
为避免空单元格问题，请使用以下代码：
Sub CopyPaste()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet1")
copySheet.Range("R:R").Copy
pasteSheet.Columns(pasteSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column + 1).PasteSpecial
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
英文:
To avoid empty cell issue use this
Sub CopyPaste()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet1")
copySheet.Range("R:R").Copy
pasteSheet.Columns(pasteSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column + 1).PasteSpecial
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
</details>
# 答案2
**得分**: 1
复制整列
-
```vb
Sub CopyEntireColumn()
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = ThisWorkbook ' 包含此代码的工作簿
Dim copySheet As Worksheet: Set copySheet = wb.Worksheets("Sheet1")
Dim pasteSheet As Worksheet: Set pasteSheet = wb.Worksheets("Sheet1")
Dim copyRange As Range: Set copyRange = copySheet.Columns("R")
Dim pasteRange As Range:
With pasteSheet.UsedRange
Set pasteRange = .Resize(, 1).Offset(, .Columns.Count).EntireColumn
End With
copyRange.Copy pasteRange
Application.ScreenUpdating = True
End Sub
```
不引入范围变量，您也可以使用更短但不太可读的方式（不建议）：
```vb
With pasteSheet.UsedRange
copySheet.Columns("R").Copy .Resize(, 1).Offset(, .Columns.Count).EntireColumn
End With
```
<details>
<summary>英文:</summary>
Copy Entire Column
-
<!-- language: lang-vb -->
Sub CopyEntireColumn()
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim copySheet As Worksheet: Set copySheet = wb.Worksheets("Sheet1")
Dim pasteSheet As Worksheet: Set pasteSheet = wb.Worksheets("Sheet1")
Dim copyRange As Range: Set copyRange = copySheet.Columns("R")
Dim pasteRange As Range:
With pasteSheet.UsedRange
Set pasteRange = .Resize(, 1).Offset(, .Columns.Count).EntireColumn
End With
copyRange.Copy pasteRange
Application.ScreenUpdating = True
End Sub
Instead of introducing the range variables, you could use the shorter but less readable
(not recommended):
With pasteSheet.UsedRange
copySheet.Columns("R").Copy .Resize(, 1).Offset(, .Columns.Count).EntireColumn
End With
</details>
# 答案3
**得分**: 0
```
不需要复制粘贴。
```
子复制范围()
Dim xLAppL As Excel.Application: Set xLAppL = GetObject(, "Excel.Application")
Dim wrkBk As Excel.Workbook: Set wrkBk = xLAppL.ActiveWorkbook
Dim wrksH As Worksheet: Set wrksH = wrkBk.ActiveSheet
Dim sourceArr() As Variant: sourceArr = wrksH.Range("r:r").Value2 '.CurrentRegion
wrksH.Range("T1").Resize(UBound(sourceArr, 1), UBound(sourceArr, 2)).Value2 = sourceArr
End Sub
```
<details>
<summary>英文:</summary>
No need to copy paste.
```
Sub copyRange()
Dim xLAppL As Excel.Application: Set xLAppL = GetObject(, "Excel.Application")
Dim wrkBk As Excel.Workbook: Set wrkBk = xLAppL.ActiveWorkbook
Dim wrksH As Worksheet: Set wrksH = wrkBk.ActiveSheet
Dim sourceArr() As Variant: sourceArr = wrksH.Range("r:r").Value2 '.CurrentRegion
wrksH.Range("T1").Resize(UBound(sourceArr, 1), UBound(sourceArr, 2)).Value2 = sourceArr
End Sub
```
</details>
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论