VBA Excel根据IF语句自动复制和粘贴特定单元格

我在下面列出的代码是工作内容和无法工作内容的组合

未注释的代码会将单元格从sheet1复制到sheet2

我无法正常工作的是我禁用的代码，该代码将取代我从表1到表2的范围处理方法

同时，我的If-Then代码也会帮助我完成我的目标。我试图得到If语句来搜索A列的所有内容，并将1991年的所有汽车复制到sheet2

注意我糟糕的编码技能，我正在尽我最大的努力展示和解释，以便我能得到帮助。 这是表1和表2

hxxp://s15.postimg.org/orfw7tlaz/test.jpg

旧代码

因此，我添加了一些行，并开始更改单元格位置，以反映我需要的格式。现在，当我运行宏时，它只将最后一行从Sheet1复制到sheet2。我相信这和这些细胞的排列顺序有关

        b.Cells(erow, 1) = a.Cells(i, 1)
        b.Cells(erow, 2) = a.Cells(i, 2)
        b.Cells(erow, 3) = a.Cells(i, 3)
        b.Cells(erow, 4) = a.Cells(i, 4)

更改这些内容可以修复它，使其复制所有单元格，但这不是我要做的。 下面是我试图运行的代码

新的代码工作感谢EntryLevel

因此，我添加了另一个带有Dim r的For循环，并添加了另一行erow=erow+r&现在代码复制了所需的前两行，但不会继续遍历列表。这让我很困惑。下面是我添加的代码

Dim r As Long
Dim i As Long
Dim lastrowsheet1 As Long
Dim erow As Long

lastrowsheet1 = c.Cells(Rows.Count, 1).End(xlUp).Row
erow = b.Cells(b.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
 For r = 1 To erow
  For i = 2 To lastrowsheet1
  If c.Cells(i, 1) = b.Cells(erow, 6) Then
     b.Cells(erow, 8) = c.Cells(i, 2)
     erow = erow + r
  End If
Debug.Print i
  Next i
  Next r

---

根据你的说法，我试图让If语句搜索A列的所有内容，并将1991年的所有汽车复制到sheet2，似乎自动筛选可能是比循环更容易的解决方案。您应该能够使用以下内容：

Sub TestyTestTest()
    Dim lastrowsheet1 As Long
    Dim lastrowsheet2 As Long

    With ThisWorkbook.Sheets("Sheet1")
        .AutoFilterMode = False
        lastrowsheet1 = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(1, 1), .Cells(lastrowsheet1, 4)).AutoFilter Field:=1, Criteria1:="1991"
        .Range(.Cells(2, 1), .Cells(lastrowsheet1, 4)).SpecialCells(xlCellTypeVisible).Copy
        .AutoFilterMode = False
    End With

    With ThisWorkbook.Sheets("Sheet2")
        .AutoFilterMode = False
        lastrowsheet2 = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Cells(lastrowsheet2 + 1, 1).PasteSpecial Paste:=xlPasteValues
        .AutoFilterMode = False
    End With
    Application.CutCopyMode = False
End Sub

编辑：

如果你想紧跟你的原始代码，像这样的东西会更像你想要的吗

Sub TakeTwo()
    Dim a As Worksheet
    Dim b As Worksheet
    Dim c As Worksheet

    Set a = ThisWorkbook.Sheets("Sheet1")
    Set b = ThisWorkbook.Sheets("Sheet2")
    Set c = ThisWorkbook.Sheets("Sheet3")

    Dim i As Long
    Dim lastrowsheet1 As Long
    Dim erow As Long

    lastrowsheet1 = a.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastrowsheet1
        If a.Cells(i, 1).Value = 1991 Then
            erow = b.Cells(b.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            b.Cells(erow, 1) = a.Cells(i, 1)
            b.Cells(erow, 2) = a.Cells(i, 2)
            b.Cells(erow, 3) = a.Cells(i, 3)
            b.Cells(erow, 4) = a.Cells(i, 4)
        End If
    Next i
    Application.CutCopyMode = False
    b.Columns.AutoFit
End Sub

第二次编辑-OP的新问题：

看起来您的数据只是在自身上粘贴，因为erow被定义为列1中最后一行之后的一行，该行不是空的，但实际上您没有将任何数据放入该列，因此erow不会向下移动到下一行

基本上，更改此行中的列号：

erow = b.Cells(b.Rows.Count, 1).End(xlUp).Offset(1, 0).Row

---

b.Cellsb.Rows.Count中的1应更改为每次粘贴数据的列号。或者，您可以使用erow作为计数器，并在每次循环中手动递增它。在这种情况下，将定义erow的现有行向上移动到定义lastrowsheet1的行下方，然后在所有粘贴完成后但在结束之前，将erow=erow+1放入循环中。如果你把它放在End If之后，你的数据之间就会有一堆空行。

无法正常工作-那代码现在做什么了？你希望它做什么？除非相邻单元格中有信息。-表1中A列=1991的相邻单元格或表2中粘贴的相邻单元格？你认为相邻的细胞是哪一个，即哪些列？GRADE’E'BACON，现在只启用SHIT1 A2、B2、C2、D2粘贴到D2、A2、C2 B2的拷贝的代码，当我再次运行宏时，它粘贴到D2+ 1，A2+ 1，C2+2B2+1 ECT。我想让代码做的是将A列中包含文本1991的所有代码复制到sheet2 D2、A2、C2 B2，这样当A列中包含1500行1999时，我就不必手动将它们复制并粘贴到sheet2。因此，您需要执行循环，遍历A列，并使用if语句确定它是否移动。z=A列中被测试单元格的行号。Scott Holtzman，我删除了相邻单元格的句子，因为它混淆了我的书写方式。Scott Craner，我不确定一个循环和if语句是否能完全满足我的要求，但我对它的想法持开放态度，也了解如何使用数组，但我不知道我是否能使用数组使代码变得非常动态。因此我明白在vba上进行自动筛选可能会使其他车辆脱离工作表1，但我需要使用if语句的原因是，我必须能够使用多个过滤器，自动搜索和复制选定的单元格，并将它们粘贴到预格式化的表格2中。听起来很傻，但我有200000行的产品列表，我需要检索信息粘贴到选定的单元格。我没有把它放在整个问题中，因为我已经觉得我把宏观问题复杂化了。我尝试使用的代码只是开始部分。我不明白为什么一个具有多个条件的过滤器和仅复制剩余可见单元格的过滤器不起作用，但我会接受它并尝试编辑您的原始代码。第2页上的列与第1页上的列的顺序是否相同？或者在粘贴数据时需要重新排列顺序吗？还有，我们想用z变量做什么？EntryLevel，z变量只是我想把事情弄清楚，但现在忽略它，以帮助你理解我所说的更大的图景。如果我要打开我的产品数据库，我

---

t有超过154000行和17列宽。格式化的sheet2的顺序完全不同，大约有50列。例如，我需要能够选择我想要的品牌，将我需要的所有产品单元格复制到正确的位置，并按照正确的纸张顺序2，然后，sheet2从sheet1的单元格中获取所需的唯一信息，sheet2的其余部分可以为空。要使其更复杂，我有多张excel表格，我需要使用某种搜索单元格自动获取信息，以获得精确的文本字符串，然后将相关行中的特定单元格复制到特定的产品。听起来很疯狂，我知道。如果我禁用b.RangeA1.Select，那么它的工作原理与我最初要求的完全一样，与我一整天都在努力完成的任务相比，你输入的代码非常简单！

Sub TestyTestTest()
    Dim lastrowsheet1 As Long
    Dim lastrowsheet2 As Long

    With ThisWorkbook.Sheets("Sheet1")
        .AutoFilterMode = False
        lastrowsheet1 = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(1, 1), .Cells(lastrowsheet1, 4)).AutoFilter Field:=1, Criteria1:="1991"
        .Range(.Cells(2, 1), .Cells(lastrowsheet1, 4)).SpecialCells(xlCellTypeVisible).Copy
        .AutoFilterMode = False
    End With

    With ThisWorkbook.Sheets("Sheet2")
        .AutoFilterMode = False
        lastrowsheet2 = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Cells(lastrowsheet2 + 1, 1).PasteSpecial Paste:=xlPasteValues
        .AutoFilterMode = False
    End With
    Application.CutCopyMode = False
End Sub

Sub TakeTwo()
    Dim a As Worksheet
    Dim b As Worksheet
    Dim c As Worksheet

    Set a = ThisWorkbook.Sheets("Sheet1")
    Set b = ThisWorkbook.Sheets("Sheet2")
    Set c = ThisWorkbook.Sheets("Sheet3")

    Dim i As Long
    Dim lastrowsheet1 As Long
    Dim erow As Long

    lastrowsheet1 = a.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastrowsheet1
        If a.Cells(i, 1).Value = 1991 Then
            erow = b.Cells(b.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            b.Cells(erow, 1) = a.Cells(i, 1)
            b.Cells(erow, 2) = a.Cells(i, 2)
            b.Cells(erow, 3) = a.Cells(i, 3)
            b.Cells(erow, 4) = a.Cells(i, 4)
        End If
    Next i
    Application.CutCopyMode = False
    b.Columns.AutoFit
End Sub

erow = b.Cells(b.Rows.Count, 1).End(xlUp).Offset(1, 0).Row