在 VBA 宏中查找复制和粘贴

Question

我正在尝试编写一个从一个 sheet 搜索数据并将其复制到另一个的宏。

但现在我遇到了一个问题，因为我想在两次搜索之间复制数据并将多个单元格中的全部数据粘贴到一个单元格中。

比如上图中我的宏：

搜索“------------”和“*****记录结束”
COPIES 之间的所有内容，这里是第 29 行和第 30 行以及 A、B、C 列中的示例数据
PASTE 将多个单元格 A29、B29、C29 和 A30、B30、C30 中的所有数据粘贴到 sheet 2 中的单个单元格单元格 E2.
此模式在 A 列中重复出现，因此我想搜索下一次出现并执行所有步骤 1、2、3，这次我将把它粘贴到 Sheet2 的单元格 E3 中。

代码如下：我能够搜索我的模式，但很难在这些搜索模式之间提供对单元格的引用，然后将所有数据复制到一个单元格。

 x = 2: y = 2: Z = 7000: m = 0: n = 0

Do
x = x + 1
If ThisWorkbook.Sheets("lic").Range("A" & x) = "---------------------" Then m = x
If ThisWorkbook.Sheets("lic").Range("A" & x) = "****** END OF RECORD" Then n = x
If (n > 0) Then

    Do
    For i = m To n
    ThisWorkbook.Sheets("lic").Range("A" & i + 1).Copy
    ThisWorkbook.Sheets("lic").Range("B" & i + 1).Copy
    ThisWorkbook.Sheets("lic").Range("C" & i + 1).Copy


'If (n > 0) Then ThisWorkbook.Sheets("Sheet1").Range("E" & y) = ThisWorkbook.Sheets("lic").Range("A" & m + 1, "C" & n - 1): y = y + 1
'If (n > 0) Then ThisWorkbook.Sheets("Sheet1").Range("E" & y).Resize(CopyFrom.Rows.Count).Value = CopyFrom.Value: y = y + 1
Loop While Not x > Z

'Driver's Licence #:Driver's Licence #:Driver's Licence #:

x = 2: y = 2: Z = 7000: counter = 1
Do
x = x + 1
If ThisWorkbook.Sheets("lic").Range("A" & x) = "Driver's Licence #:" Then counter = counter + 1
If (counter = 2) Then ThisWorkbook.Sheets("Sheet1").Range("B" & y) = ThisWorkbook.Sheets("lic").Range("C" & x): y = y + 1: counter = 0
If x = Z Then Exit Sub
Loop
End Sub

Answer 1

我完全不确定你想在最终输出中看到什么，所以这是一个有根据的猜测：

Sub DenseCopyPasteFill ()

  Dim wsFrom, wsTo As Worksheet
  Dim ur As Range
  Dim row, newRow As Integer
  Dim dataOn As Boolean
  Dim currentVal As String

  dataOn = False
  newRow = 3

  Set wsFrom = Sheets("Sheet1")
  Set wsTo = Sheets("Sheet2")
  Set ur = wsFrom.UsedRange

  For row = 1 To ur.Rows.Count
    If wsFrom.Cells(row, 1).Value2 = "--------------" Then
      dataOn = True
    ElseIf wsFrom.Cells(row, 1).Value2 = "***** END OF RECORD" Then
      newRow = newRow + 1
      dataOn = False
    ElseIf dataOn Then
      currentVal = wsTo.Cells(newRow, 5).Value2
      wsTo.Cells(newRow, 5).Value2 = currentVal & _
          wsFrom.Cells(row, 1) & wsFrom.Cells(row, 2) & _
          wsFrom.Cells(row, 3)
    End If

  Next row
End Sub

如果你不用 Windows 剪贴板就可以离开，我愿意。我在这里演示了如何简单地添加或附加一个值，而不是 copy/paste。

Answer 2

添加这个子：

Sub copy_range(rng As Range)
Dim str As String
str = rng.Cells(1).Value & rng.Cells(2).Value & rng.Cells(3).Value
Range("E" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value = str
End Sub

那么你的 for 循环应该是这样的：

For i = m To n
    copy_range ThisWorkbook.Sheets("lic").Range("A" & i + 1 & ":C" & i + 1)
Next i

Answer 3

考虑到搜索工作正常，关于复制你只需要做的事情：

Sheet2.Range("E2").value = ThisWorkbook.Sheets("lic").Range("A" & i + 1).value & ";" & ThisWorkbook.Sheets("lic").Range("B" & i + 1).value & ";" & ThisWorkbook.Sheets("lic").Range("C" & i + 1).value

结果将类似于：AIR COO；大数据； A

--------更新---------

很难理解你的代码，所以我要写一个新的。基本上它是将在 sheet1 上找到的内容复制到 sheet2。

Sub Copy()

Dim count As Integer 'Counter of loops to the for
Dim Z As Integer 'Limit of (?)
Dim h As Integer 'Count the filled cells on sheet2
Dim y As Integer 'Counter the columns to be copied

Z = 7000
h = 1


'Assuming that the "----" will always be on the top, the code will start searching on the second row
'if it's not true, will be needed to validate this to.
For count = 2 To Z

    If Sheet1.Cells(count, 1).Value <> "****** END OF RECORD" Then

        If Sheet1.Cells(count, 1).Value <> "" Then

            For y = 1 To 3 'In case you need to copy more columns just adjust this for.

                Sheet2.Cells(h, 1).Value = Sheet2.Cells(h, 1).Value & Sheet1.Cells(count, y).Value

            Next y

            h = h + 1

        End If

    Else

        MsgBox "END OF RECORD REACHED"
        Exit Sub

    End If

Next count

End Sub

也许我不太明白，但这可能对你有用。

在 VBA 宏中查找复制和粘贴

Find Copy and Paste in VBA macro

vba

copy

find

paste