首页 > 解决方案 > Excel VBA复制和粘贴具有某些值的单元格从一个工作表到另一个工作表

问题描述

我正在尝试遍历一系列单元格,并将非空白或不包含“X”的单元格的值(以及其右侧的两个单元格)复制并粘贴到另一个工作表上的列中。我希望我将它们粘贴到的单元格将保留在将内容粘贴到它们之前设置的预先格式化的条件格式。到目前为止,我所拥有的不起作用,并且不考虑与复制单元格相邻的单元格 2,或者只是粘贴没有格式化的值。如果那时我可以按字母顺序对第一对单元格进行排序(也不考虑),那就太好了。谢谢你的帮助!

Sub Wire_List_Export()

Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim c As Range
Dim j As Integer

Set copySheet = Worksheets("LV Schedule")
Set pasteSheet = Worksheets("test")

For Each c In copySheet.Range("G274:G10000")
    If Not c = "X" Or Not IsEmpty(c) Then
        copySheet.Cells(c).Copy pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End If
Next c
End Sub

标签: excelvbafor-loopcopypaste

解决方案


这是你想要的?

Sub Wire_List_Export()

    'Declarations.
    Dim RngCopyRange As Range
    Dim IntOffsetCopy As Integer
    Dim RngPasteRange As Range
    Dim RngCell As Range

    'Turning off screen updating.
    Application.ScreenUpdating = False

    'Setting variables.
    Set RngCopyRange = Worksheets("LV Schedule").Range("G274:H10000")
    Set RngPasteRange = Worksheets("test").Range("A1:B9727")

    'Copying the range.
    RngCopyRange.Copy

    'Pasting the range (only values, skipping blank cells).
    RngPasteRange.PasteSpecial Paste:=xlPasteValues, _
                               Operation:=xlNone, _
                               SkipBlanks:=True, _
                               Transpose:=False

    'Turning off cut-copy mode.
    Application.CutCopyMode = False

    'Turning on screen updating.
    Application.ScreenUpdating = True

End Sub

推荐阅读