Excel VBA - copy data to another sheet to specific ranges based on a criteria, then loop through all data.

[Jesuares]

Hello everyone

I have all this data in one workbook called "Data".

Depending on the left number ("1714"), there is a number in the right that specifies the amount of times the number has shown. In each row, the data from column C to column J changes.

Depending on how many times the number appears, i need to copy the data to another sheet called "Dataport". My problem is that the copy method changes based on how many times the number appears. It changes if the number appears 1 time, 2 times, 3 times, 4 times, and if it appears 5 times or more the criteria to copy will be the same ( i have prints the specific ranges to copy depending on the number)

When it stops copying the data from the number, i want to pass to the other number and do the same process of copying, starting in a specific cell.

The range to copy is 55 rows. However, if the number of times the number shows huge, i have to add more lines so i can copy all data.

Therefore, i copy the data and 55 rows after, starting from the "first copy", i do the same process for another number.

I hope i was explicit, and i can give more details so you can help me do a macro to this process, since it is really automatic and has, i guess, five variables and then loop all the data sheet.

 

[DanteAmor]

Hi and welcome to MrExcel!

If the images of the results once, twice and three times, correspond to the first 3 records of your data, then try the following macro.

The data in your "Data" sheet, starting at cell A1, results in the "Dataport" sheet.

Sub copy_data_to_another_sheet()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant, d As Variant
  Dim nmax As Long, xtra As Long, t As Long, acum As Long, ini As Long
  Dim i As Long, j As Long, k As Long, lr As Long, m As Long, n As Long, p As Long
  Dim datacolf As Variant, ant As Variant
  Dim rng As Range
  
  Set sh1 = Sheets("Data")        'data sheet
  Set sh2 = Sheets("Dataport")    'destination sheet
  
  sh2.Cells.ClearContents
  
  lr = sh1.Range("A" & Rows.Count).End(3).Row
  xtra = sh1.Range("V" & Rows.Count).End(3).Row
  Set rng = sh1.Range("B1:B" & lr)
  nmax = WorksheetFunction.Max(rng)
  
  For i = 1 To nmax
    n = WorksheetFunction.CountIf(rng, i)
    t = (n * i * 8) + xtra + 2
    acum = acum + t
  Next

  a = sh1.Range("A1:J" & lr).Value
  c = sh1.Range("O1:T" & sh1.Range("O" & Rows.Count).End(3).Row).Value
  d = sh1.Range("V1:V" & xtra).Value
  ReDim b(1 To acum, 1 To 11)
  
  k = 1
  ini = 1
  p = 0
  For i = 1 To lr
    If ant <> a(i, 1) Then
      p = i
      ini = i
      datacolf = a(i, 6)
    End If
    For j = 1 To a(i, 2)
    
      'First line columns from O to S
      b(k, 1) = c(1, 1)
      b(k, 2) = c(1, 2)
      b(k, 3) = c(1, 3)
      b(k, 4) = c(1, 4)
      b(k, 5) = c(1, 5)
      
      b(k, 6) = a(p, 3)
      
      b(k, 7) = a(p, 7)
      b(k, 8) = a(p, 7)
      b(k, 9) = a(p, 7)
      b(k, 10) = 1
      b(k, 11) = a(p, 8)
      
      b(k + 1, 6) = a(p, 4)
      b(k + 2, 6) = a(p, 5)
      
      k = k + 4
      
      'Second line columns from O to T
      b(k, 1) = c(2, 1)
      b(k, 2) = c(2, 2)
      b(k, 3) = c(2, 3)
      b(k, 4) = c(2, 4)
      b(k, 5) = c(2, 5)
      b(k, 6) = c(2, 6)
  
      b(k, 7) = a(p, 7)
      b(k, 8) = a(p, 7)
      b(k, 9) = a(p, 7)
      b(k, 10) = 1
      b(k, 11) = a(p, 8)
      
      If j = a(i, 2) Then
        'Third line column F
        k = k + 2
        b(k, 6) = datacolf
        
        'Fourth  line column V
        For m = 1 To xtra
          k = k + 1
          b(k, 6) = d(m, 1)
        Next
      End If
      k = k + 2
      p = p + 1
    Next
    sh2.Range("A2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
    ant = a(i, 1)
    p = ini
    ini = i
  Next
End Sub

NOTE XL2BB:
For the future, it would help greatly if you could give us the sample data in a form that we can copy to test with, rather that a picture.

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.