1

私は現在、以下のスクリプトを実行しています

Sub Gift_Certificate()

    'Select Bridge Data from tab, cell A2
    Sheets("Bridge Data").Select
    Range("A2").Select

    'Loop while activecell is not blank (goes down the column)
    Do While ActiveCell <> ""
        'Repeat below step if data needs to be sorted into multiple wksts'
        '  Also, create individual worksheets for each
        If InStr(1, ActiveCell, "Gift Certificate", 1) <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("GC Redeemed").Select
            Range("A10").Select

        Else
            'If it's not an extension you have specified, it highlites the cell because its cool'
            ActiveCell.Interior.ColorIndex = 6
            GoTo SKIPPING
        End If

        Range("A10").Select
        'Loops down until there's an open cell'
        Do While ActiveCell <> ""
            ActiveCell.Offset(1, 0).Select
        Loop

        ActiveSheet.PasteSpecial

        'Go back to the starting sheet & iterate to the next row
        Sheets("Bridge Data").Select
SKIPPING:
        ActiveCell.Offset(1, 0).Select
    Loop

End Sub

これを使用して、あるタブのデータをスキャンし、選択したデータを別のタブにコピーしています。私が直面している問題は、新しく貼り付けたデータから数式を実行したいのですが、スクリプトを実行すると、新しい行がタブに挿入され、すべての数式が押し下げられます。

挿入ではなく、スクリプトにデータを新しいタブにコピーさせたいだけです。

何かアドバイス？

ps、私はvbの経験がほとんどないので、気楽にやってください！

ありがとう、

-ショーン

4

1 に答える 1

0

これは、フィルタリングを使用して基準を満たす範囲を選択し、それをターゲット シートの最後にコピーする、非常に異なるアプローチです。式の要件にどのように影響するかはわかりませんが、試してみてください。

Sub Gift_Certificate()
Dim wsSource As Excel.Worksheet
Dim wsTarget As Excel.Worksheet
Dim SourceLastRow As Long
Dim TargetNextRow As Long

Set wsSource = ThisWorkbook.Sheets("Bridge Data")
Set wsTarget = ThisWorkbook.Sheets("GC Redeemed")
'Find the next empty row in the target sheet
With wsTarget
    TargetNextRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With
With wsSource
    'Find the last filled row in the source sheet
    SourceLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    'Turn off any Autofilters in case they are in other columns
    'I think this is the best way to handle this
    If .AutoFilterMode Then
        .AutoFilterMode = False
    End If
    'Filter to non-matching, and fill with yellow
    .Range("A1").AutoFilter Field:=1, Criteria1:="<>Gift Certficate*", Operator:=xlAnd
    .Range("A2:A" & SourceLastRow).Interior.ColorIndex = 6
    'Filter to matching and copy to target sheet
    .Range("A1").AutoFilter Field:=1, Criteria1:="=Gift Certficate*", Operator:=xlAnd
    .Range("A2:A" & SourceLastRow).EntireRow.Copy Destination:= _
                                                  wsTarget.Range("A" & TargetNextRow)
'Turn off autofilter
    .AutoFilterMode = False
End With
End Sub
于 2012-09-18T23:56:43.720 に答える