2

次のコードを変更して、特定のセル範囲または列のみをコピーする方法はありますか:

例: 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

最終コード - 編集済み:

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
4

3 に答える 3

1

テストされていませんが、変更してみてください

.Range("A2:F" & LR).Copy Range("A2")

に

.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")

編集：

フィルター ヘッダーが行 6 にあるときに、行 1 でフィルター処理しようとしています。また、行全体ではなく、オートフィルターを適用する正確な範囲を設定するようにしてください。

.AutoFilterMode = False
.Range("D6:AF6").AutoFilter Field:=24, Criteria1:="Breached"

また、構文が正しくないため、PasteSpecial が機能していません。最初にコピーしてから、範囲に PasteSpecial する必要があります。

http://msdn.microsoft.com/en-us/library/office/ff839476.aspx

于 2013-05-07T14:13:06.493 に答える