Question

我正在尝试将值从多张纸复制/粘贴到一张纸上。

我已经循环下来了，但是宏覆盖了要写入数据的同一列中的值。

Sub Main()
    MedRT_EPC Sheets("Chemical Structure (14)")
    MedRT_EPC Sheets("Enzymes (19)")
    MedRT_EPC Sheets("Diuretics (5)")
    MedRT_EPC Sheets("Imaging Agents (12)")
    MedRT_EPC Sheets("Vitamins (27)")
End Sub


Sub MedRT_EPC(ws As Worksheet)

    ' Copy EPC cells Macro
    Dim bottomL As Integer
    Dim x As Integer
    bottomL = ws.Range("I" & Rows.Count).End(xlUp).Row: x = 1
 
    Dim c As Range
    For Each c In ws.Range("I:I" & bottomI)
        If c.Value = "EPC" Then
            c.EntireRow.Copy Worksheets("sheet4").Range("A" & x)
            x = x + 1
        End If
    Next c

End Sub

我尝试添加以下内容：

    Dim LastTargetRow As Long
    ' code here
    With ws
        LastTargetRow = .Range("I" & Rows.Count).End(xlUp).Row + 1
    End With
    ' code here

Answer 1

如上所述，Autofilter会更快（或使用Find），但是如果坚持使用循环，最主要的是不要在粘贴范围的第一行开始每个工作表。

Sub MedRT_EPC(ws As Worksheet)

' Copy EPC cells Macro
Dim bottomL As Long, x As Long

bottomL = ws.Range("I" & Rows.Count).End(xlUp).Row

Dim c As Range

For Each c In ws.Range("I2:I" & bottomL) 'or I1 as applicable
    If c.Value = "EPC" Then
        x = Worksheets("sheet4").Range("I" & Rows.Count).End(xlUp).Row + 1
        c.EntireRow.Copy Worksheets("sheet4").Range("A" & x)
    End If
Next c

End Sub

Answer 2

您的问题是“ x”不变。试试下面的代码。用所需的数字填充x1，x2，x3，x4和x5。

   Sub Main()
        MedRT_EPC Sheets("Chemical Structure (14)",x1)
        MedRT_EPC Sheets("Enzymes (19)",x2)
        MedRT_EPC Sheets("Diuretics (5)",x3)
        MedRT_EPC Sheets("Imaging Agents (12)",x4)
        MedRT_EPC Sheets("Vitamins (27)"x5)
    End Sub
    Sub MedRT_EPC(ws As Worksheet, x as Integer)

' Copy EPC cells Macro
 Dim bottomL As Integer
 bottomL = ws.Range("I" & Rows.Count).End(xlUp).Row: x = 1


 Dim c As Range
 For Each c In ws.Range("I:I" & bottomI)
 If c.Value = "EPC" Then
 c.EntireRow.Copy Worksheets("sheet4").Range("A" & x)

 End If
 Next c

End Sub

从一张纸的最后一行循环到下一张纸的第一行

2 个答案: