Find Copy and Paste in VBA macro

Question

I am trying to write a macro which search data from one sheet and copy's to another.

But now I have a problem because I want to copy data between two searches and paste the whole data from multiple cells into one single cell.

For example in the above picture my macro:

1. SEARCH for "--------------" and "*****END OF RECORD"
2. COPIES everything in between , here example data in row 29 and 30 and from column A,B,C

3. PASTE all the data from multiple cells A29,B29,C29 and then A30,B30,C30 to single cell in sheet 2 say cell E2.

4. This pattern is reoccurring in the column A so I want to search for the next occurrence and do all the steps 1,2,3 and this time I will paste it in Sheet2 , cell E3.

Below is the code: I am able to search my pattern but hard time in giving references to the cells in between those searched patterns and then copying all the data to ONE cell.

 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

I'm not at all sure what you want to see in the final output, so this is an educated guess:

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

If you can get away without using the Windows clipboard, I would. Instead of copy/paste, here I demonstrated how you can simply add or append a value.

Answer 2

Add this sub:

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

Then your for loop should look like this:

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

Answer 3

Considering that the search is working correctly, about the copy thing you just need to do:

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

The result will be something like: AIR COO; L DAT; A

--------UPDATE---------

It was hard to understand your code, so I'm write a new one. Basically it's copy what it found on sheet1 to 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

Maybe I don't get the full idea but this might work for you.