在VBA宏中查找復制和粘貼

Question

我正在嘗試編寫一個宏，該宏從一張紙搜索數據並將其復制到另一張紙。

但是現在我遇到了一個問題，因為我想在兩次搜索之間復制數據並將整個數據從多個單元格粘貼到一個單元格中。

例如上圖中的我的宏：

1. 搜索 “ --------------”和“ *****記錄結束”
2. 復制之間的所有內容，此處示例第29行和第30行以及A，B，C列中的數據

3. 將所有數據從多個單元格A29，B29，C29然后粘貼到A30，B30，C30 粘貼到工作表2中的單個單元格，即單元格E2。

4. 此模式在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剪貼板就可以離開，我會的。 在這里，我演示了如何簡單地添加或附加值，而不是復制/粘貼。

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; L DAT； 一種

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

很難理解您的代碼，所以我要編寫一個新代碼。 基本上是將在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

也許我沒有完整的主意，但這可能對您有用。