copiar celdas a la hoja en base a la coincidencia de criterios

He estado trabajando en este proyecto por un tiempo y siento que me estoy acercando tanto pero que al final me encuentro con problemas. He extraído fragmentos de este código de diferentes fuentes. Me complace decir que no recibo ningún error. Lamentablemente, tampoco obtengo resultados.

Tengo dos hojas, una tiene datos estáticos (principal) y la otra se actualiza semanalmente para copiar / pegar (fuente). Lo que intento hacer es unir datos concatenados de principal a fuente y copiar celdas específicas en una coincidencia. cuando ejecuto la macro obtengo resultados en una línea de 50. El bucle interno continúa hasta el final de la hoja, pero el bucle externo no parece cambiar la fila en la hoja de destino (principal) No estoy realmente seguro de cómo se está poblando una fila. Sé que me estoy perdiendo algo aquí, pero ¿qué?

Dim wsSource As Worksheet
Dim wsMain As Worksheet
Dim rngs As Variant
Dim rngm As Variant
Dim srow As Integer
Dim mrow As Integer
Dim i As Long
Dim lastrow As Long




Set wsSource = Worksheets("Source")
Set wsMain = Worksheets("Main")

Set rngs = wsSource.Range("L2")
Set rngm = wsMain.Range("L2")





    'Clear old data
    wsMain.Range("D2:L1500").ClearContents
    wsSource.Range("L2:L1500").ClearContents


    wsMain.Range("L2:L" & Range("A65000").End(xlUp).Row).FormulaR1C1 = "=CONCATENATE(RC[-11],RC[-10],RC[-9])"
    wsSource.Range("L2:L" & Range("A65000").End(xlUp).Row).FormulaR1C1 = "=CONCATENATE(RC[-11],RC[-10],RC[-9])"

    lastrow = Range("L" & Rows.Count).End(xlUp).Row
    srow = 2
    mrow = 2


    Do Until rngm.Offset(mrow, 0).Value <> "" And rngm.Offset(mrow, 1).Value <> ""


        Do Until rngs.Offset(srow, 0).Value <> "" And rngs.Offset(mrow, 1).Value <> ""

            If (rngs.Offset(srow, 0).Value = rngm.Offset(mrow, 0).Value) Then

            rngm.Offset(mrow, -8).Value = rngs.Offset(srow, -8).Value
            rngm.Offset(mrow, -7).Value = rngs.Offset(srow, -7).Value
            rngm.Offset(mrow, -6).Value = rngs.Offset(srow, -6).Value
            rngm.Offset(mrow, -5).Value = rngs.Offset(srow, -5).Value
            rngm.Offset(mrow, -4).Value = rngs.Offset(srow, -4).Value
            rngm.Offset(mrow, -3).Value = rngs.Offset(srow, -3).Value
            rngm.Offset(mrow, -2).Value = rngs.Offset(srow, -2).Value
          End If
        srow = srow + 1
        Loop
    mrow = mrow + 1
Loop

Estaré encantado de cargar el libro de trabajo si hay una manera de hacerlo

Como no ha especificado los criterios ni ha adjuntado los datos de la muestra. De modo que me gustaría sugerirle un método similar para copiar datos coincidentes de una hoja a otra.

NB: este código coincide con la celda A1 de ambas hojas, para copiar datos.

Sub Copy&Paste()

Dim sht As Worksheet 
Dim newsht As Worksheet 

Set sht = ThisWorkbook.Worksheets("Sheet1")
Set newsht = ThisWorkbook.Worksheets("Sheet2")

Set dat = sht.Range("A1")
Set newdat = newsht.Range("A1")

Dim i, j, iRow As Integer   
i = 1
j = 1
iRow = 1

'For Header Row
newdat.Offset(0, 0).Value = dat.Offset(0, 0).Value 
newdat.Offset(0, 1).Value = dat.Offset(0, 2).Value 
newdat.Offset(0, 2).Value = dat.Offset(0, 3).Value 
newdat.Offset(0, 3).Value = dat.Offset(0, 4).Value 
newdat.Offset(0, 4).Value = dat.Offset(0, 5).Value 
newdat.Offset(0, 5).Value = dat.Offset(0, 6).Value 

Do While dat.Offset(i, 0).Value <> "" Or dat.Offset(i, 1).Value <> ""

  j = 1     

  Do While dat.Offset(j, 0).Value <> ""

    If (newdat.Offset(i, 0).Value = dat.Offset(j, 4).Value _
    Or newdat.Offset(i, 1).Value = dat.Offset(j, 5).Value) _
    And dat.Offset(j, 6).Value = "your criteria" Then

    'This copies Data.

      newdat.Offset(iRow, 0).Value = dat.Offset(j, 0).Value 
      newdat.Offset(iRow, 1).Value = dat.Offset(j, 2).Value 
      newdat.Offset(iRow, 2).Value = dat.Offset(j, 3).Value 
      newdat.Offset(iRow, 3).Value = dat.Offset(j, 4).Value 
      newdat.Offset(iRow, 4).Value = dat.Offset(j, 5).Value 
      newdat.Offset(iRow, 5).Value = dat.Offset(j, 6).Value 
      iRow = iRow + 1
    End If
    j = j + 1     
  Loop

  i = i + 1     

Loop

End Sub

Tenga en cuenta que con el comando Desplazamiento puede cambiar el rango de datos según lo necesite. Además, probé este código antes de subirlo aquí.

Espero que esto te ayude.

Encuentro que todo el rango de compensación es bastante confuso, ¿qué sucede si simplemente compensa rngsy rngm?

Set rngs = wsSource.Range("L4") ' L2 offset by (2,0)
Set rngm = wsMain.Range("L4") ' L2 offset by (2,0)

Do Until rngm.Value <> "" And rngm.Offset(0, 1).Value <> ""
    Do Until rngs.Value <> "" And rngs.Offset(0, 1).Value <> ""
        If (rngs.Value = rngm.Value) Then
            wsMain.Range("D" & rngm.row & "J" & rngm.row) = wssource.Range("D" & rngs.row & "J" & rngs.row)
        End If
        Set rngs = rngs.Offset(1,0)
    Loop
    Set rngm = rngm.Offset(1,0)
Loop

Hay otra forma de recorrer tus celdas:

For i = 5 to wsSource.Range("L" & Rows.Count).End(xlUp).Row
    Set rngm = wsSource.Range("L" & i)
    For j = 5 to wsSource.Range("L" & Rows.Count).End(xlUp).Row
        Set rngs = wsSource.Range("L" & j)
        If (rngs.Value = rngm.Value) Then
            wsMain.Range("D" & i & "J" & i) = wssource.Range("D" & j & "J" & j)
            Exit For
        End If
    Next j
Next i

Alternativamente:

For each rngm in wsSource.Range("L5:L" & Rows.Count).End(xlUp).Row
    For each rgns in wsSource.Range("L5:L" & Rows.Count).End(xlUp).Row
        If (rngs.Value = rngm.Value) Then
            wsMain.Range("D" & rngm.row & "J" & rngm.row) = wssource.Range("D" & rngs.row & "J" & rngs.row)
            Exit For
        End If
    Next rngs
Next rngm

También debería funcionar