如果X = True,则将值从一个工作表粘贴到另一个工作表

时间:2014-06-18 01:07:29

标签: excel vba excel-vba paste

我正在尝试创建一个宏,如果第五个工作表中的列F = 3,则将值3(A到E列)的左侧粘贴到另一个工作表(工作表1)中。我似乎无法开始。当我运行宏时没有任何反应。我确信我犯了一堆愚蠢的错误。

提前感谢您的帮助!

杰克

Sub Movevalues()
        Dim q As Integer, w As Integer
    w = 7
    For q = 1 To 1000
        If ActiveWorkbook.Worksheets("Taxable Accounts Import").Cells(q, 6).Value = 3 Then
            Range(Cells(q, 1), Cells(q, 5)).Select
            Selection.Copy
            Worksheets(1).Select
            Range(22, w).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Worksheets(5).Select
            w = w + 1
        End If
    Next q
End Sub

2 个答案:

答案 0 :(得分:1)

我认为使用一些变量而不是显式引用会更容易。这样做更容易的一件事是你不需要保持"选择"床单来回。

我会尝试评论我正在做的事情,这样你就可以理解了。

未经测试,请告知我是否有任何问题。

Sub Movevalues()
    Dim q As Integer, w As Integer
    Dim wsSource as Worksheet      'represents the SOURCE worksheet
    Dim wsDest as Worksheet        'represents the DESTINATION worksheet
    Dim copyRange as Range         'represents the range we want to COPY
    Dim destRange as Range         'represents the destination range

    'Initialize some variables
    w = 7
    Set wsSource = ActiveWorkbook.Worksheets("Taxable Accounts Import")
    Set wsDest = ActiveWorkbook.Worksheets(1)

    For q = 1 To 1000
        With wsSource
        If .Cells(q, 6).Value = 3 Then

            'Define the range to be "copied"
            Set copyRange = .Range(.Cells(q,1), .Cells(q, 5))

            'Define the destination range using the Resize method:
            Set destRange = wsDest.Range(22, w).Resize(1,copyRange.Columns.Count)

            'Here, we don't need to select or even "copy" anything, we can write directly
            '  to one range, from another.
            destRange.Value =  copyRange.Value

            'ensure that w identifies the next column and does not overwrite the values
            ' that we just transferred, above.
            w = w + copyRange.Columns.Count
        End If
    Next q
End Sub

注意:这假设您打算复制数据并将所有放在目标表单上的一行中,根据您的示例(使用第22行,列w作为粘贴目标)。

答案 1 :(得分:1)

我认为这里的问题是你要从Worksheets(5)连续复制5个单元格,但每个for循环只会将w递增1。如果目标确实要添加到Worksheets(1)上的同一行,则需要将w增加5而不是......这是一个很好的,简单的解决方法哈哈:

w = w + 5

话虽这么说,你循环1000次,这意味着可能有1000个匹配,这将填充1000列(如果我的by-5校正是准确的,则 5000 列)。好多啊!如果您打算从第7行第22列开始,并从那里增加行,我可能会使用以下策略。 (严重评论解释发生了什么......)

Option Explicit
Sub MoveValuesRev2()

Dim q As Long, w As Long
Dim TAI As Worksheet, SheetOne As Worksheet, _
    SheetFive As Worksheet
Dim Source As Range, Target As Range

'set references up-front
w = 7
Set TAI = ThisWorkbook.Worksheets("Taxable Accounts Import")
Set SheetOne = ThisWorkbook.Worksheets(1)
Set SheetFive = ThisWorkbook.Worksheets(5)

'loop through the cells in question
For q = 1 To 1000
    If TAI.Cells(q, 6).Value = 3 Then
        'store the left-of-the-found-value-3 cells in a range
        With SheetFive
            Set Source = .Range(.Cells(q, 1), .Cells(q, 5))
        End With
        'set the target range in row w, col 22
        With SheetOne
            Set Target = .Cells(w, 22)
        End With
        'the next two lines are the copy and paste step
        Source.Copy
        Target.PasteSpecial (xlPasteValues)
        'increment w
        w = w + 1
    End If
Next q

End Sub