如何使用 VBA 复制特定列
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16420923/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to copy specific columns using VBA
提问by user1170376
Is there a way I can change the following code to only copy specific cells range or columsn:
有没有办法可以更改以下代码以仅复制特定的单元格范围或列：
For example: I have data in all columns from A to Z. I want to copy data to another sheet but I only want to copy the data from Column A, D, H and J(A2, D2, H2, J2).
例如：我在从 A 到 Z 的所有列中都有数据。我想将数据复制到另一个工作表，但我只想从 A、D、H 和 J（A2、D2、H2、J2）列复制数据。
Option Explicit
Private Sub Worksheet_Activate()
Dim LR As Long
Me.UsedRange.Offset(1).ClearContents 'clear existing data
With Sheets("Raw - Incident Request Report")
.AutoFilterMode = False 'remove any prior filtering
.Rows(1).AutoFilter 'activate autofilter
.Rows(1).AutoFilter 27, Criteria1:="Breached" 'filter column D for 80%+
LR = .Range("D" & .Rows.Count).End(xlUp).Row 'is any data visible?
If LR > 1 Then
.Range("AC7:AC" & LR).Copy Range("C3") 'copy any data visible to report
.Range("D7:D" & LR).Copy Range("D3")
.Range("I7:I" & LR).Copy Range("E3")
.Range("K7:K" & LR).Copy Range("F3")
.Range("T7:T" & LR).Copy Range("G3")
Else
Range("C3") = "No Data Found" 'if none, give that message
End If
.AutoFilterMode = False 'turn off autofilter
End With
End Sub
FINAL CODE - EDITED:
最终代码 - 编辑：
Option Explicit
Private Sub Worksheet_Activate()
Dim LR As Long
Me.UsedRange.Offset(17).ClearContents
With Sheets("Raw - Incident Request Report")
.AutoFilterMode = False
LR = .Range("D" & .Rows.Count).End(xlUp).Row
.Range("D6:AH" & LR).AutoFilter Field:=26, Criteria1:="<>"
If LR > 1 Then
.Range("AC7:AC" & LR).Copy
Sheets("Tickets").Range("C17").PasteSpecial xlPasteValues
.Range("D7:D" & LR).Copy
Sheets("Tickets").Range("D17").PasteSpecial xlPasteValues
.Range("I7:I" & LR).Copy
Sheets("Tickets").Range("E17").PasteSpecial xlPasteValues
.Range("K7:K" & LR).Copy
Sheets("Tickets").Range("F17").PasteSpecial xlPasteValues
.Range("T7:T" & LR).Copy
Sheets("Tickets").Range("G17").PasteSpecial xlPasteValues
Else
Range("C17") = "No Data Found"
End If
.AutoFilterMode = False
End With
End Sub
回答by Joseph
Untested, but try changing
未经测试，但尝试改变
.Range("A2:F" & LR).Copy Range("A2")
to
到
.Range("H2:H" & LR).Copy Range("A2") 'copy any data visible to report
.Range("D2:D" & LR).Copy Range("B2")
.Range("J2:J" & LR).Copy Range("C2")
.Range("A2:A" & LR).Copy Range("D2")
EDIT:
编辑：
You are trying to filter on Row 1 when your filter headers are on row 6. You should also try to set the exact range to apply an autofilter on as well rather than the entire row.
当您的过滤器标题位于第 6 行时，您正尝试在第 1 行进行过滤。您还应该尝试设置准确的范围以应用自动过滤器，而不是整行。
.AutoFilterMode = False
.Range("D6:AF6").AutoFilter Field:=24, Criteria1:="Breached"
Also, your PasteSpecial isn't working because the syntax isn't correct. You have to Copy first, then PasteSpecial on a range.
此外，您的 PasteSpecial 无法正常工作，因为语法不正确。您必须先复制，然后在某个范围内进行 PasteSpecial。
http://msdn.microsoft.com/en-us/library/office/ff839476.aspx
http://msdn.microsoft.com/en-us/library/office/ff839476.aspx
回答by Dan Donoghue
Here is a modified version of your code to use arrays for the ranges and cut down on repetition. Please note, the correct answer to this post is Joseph4tw, my answer is just code advice.
这是您的代码的修改版本，用于将数组用于范围并减少重复。请注意，这篇文章的正确答案是 Joseph4tw，我的答案只是代码建议。
Private Sub Worksheet_Activate()
Dim LR As Long, MyCopyRange As Variant, MyPasteRange As Variant, X As Long
Me.UsedRange.Offset(17).ClearContents
With Sheets("Raw - Incident Request Report")
.AutoFilterMode = False
LR = .Range("D" & .Rows.Count).End(xlUp).Row
MyCopyRange = Array("AC7:AC" & LR, "D7:DC" & LR, "I7:IC" & LR, "K7:K" & LR, "T7:TC" & LR) 'Put ranges in an array
MyPasteRange = Array("C17", "D17", "E17", "F17", "G17")
.Range("D6:AH" & LR).AutoFilter Field:=26, Criteria1:="<>"
If LR > 1 Then
For X = LBound(MyCopyRange) To UBound(MyCopyRange) 'Loop the array copying and pasting based on element in the array
.Range(MyCopyRange).Copy
Sheets("Tickets").Range(MyPasteRange).PasteSpecial xlPasteValues
Next
Else
Range("C17") = "No Data Found"
End If
.AutoFilterMode = False
End With
End Sub
