Copie la fila de la Lista Maestra si la Columna D contiene cierto text

bastante nuevo para VBA, así que podría usar algo de ayuda con este, ya que he estado luchando toda la mañana con él. Tengo una list maestra y en la columna D hay palabras como "1x diario" y "1x mes". Mi objective es que todo lo que dice en esa columna, se ponga en la nueva hoja respectiva. Entonces, en este caso, si D2 = "1x Daily", toda la fila se copy en la hoja titulada "1x Daily".

Debajo está mi último bash, pero no funcionará por varias razones que asumo, pero es el mejor bash que se me ocurrió

Sub Test() For Each Cell In Sheet(1).Range("D:D") If Cell.Value = "1x Daily AM" Then matchRow = Cell.Row Rows(matchRow & ":" & matchRow).Select Selection.Copy Sheets("1x Daily All").Select ActiveSheet.Rows(matchRow).Select ActiveSheet.Paste Sheets("Master Vitals Data").Select End If Next End Sub 

Editar, cuando estoy en el editor y trato de ejecutar el código, aparece el post de error "Error de compilation. Sub o function no definida"

Aquí hay otra solución que podría funcionar aún mejor para usted:

 Option Base 0 Option Explicit Option Compare Text Sub TestRevised() Dim cell As Range Dim cmt As Comment Dim bolFound As Boolean Dim sheetNames() As String Dim lngItem As Long, lngLastRow As Long Dim sht As Worksheet, shtMaster As Worksheet 'Set master sheet Set shtMaster = ThisWorkbook.Worksheets("Master Vitals Data") 'Get the names for all other sheets ReDim sheetNames(0) For Each sht In ThisWorkbook.Worksheets If sht.Name <> shtMaster.Name Then sheetNames(UBound(sheetNames)) = sht.Name ReDim Preserve sheetNames(UBound(sheetNames) + 1) End If Next sht ReDim Preserve sheetNames(UBound(sheetNames) - 1) For Each cell In shtMaster.Range("D1:D" & shtMaster.Cells(shtMaster.Rows.Count, "D").End(xlUp).Row) bolFound = False For lngItem = LBound(sheetNames) To UBound(sheetNames) If cell.Value2 = sheetNames(lngItem) Then bolFound = True Set sht = ThisWorkbook.Worksheets(sheetNames(lngItem)) On Error GoTo SetFirst lngLastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1 On Error GoTo 0 shtMaster.Rows(cell.Row).EntireRow.Copy Destination:=sht.Cells(lngLastRow, 1) End If Next lngItem If bolFound = False Then For Each cmt In shtMaster.Comments If cmt.Parent.Address = cell.Address Then cmt.Delete Next cmt cell.AddComment "no sheet found for this row" End If Next Exit Sub SetFirst: lngLastRow = 1 Resume Next End Sub 

Esencialmente, este código primero reúne todos los nombres de las hojas en el file de Excel y luego los compara con el contenido de la celda en la columna D para cada fila. Si hay una hoja para lo que está escrito en la columna D, entonces se copy la fila. De esta manera, puede tener hojas no solo mensuales o semanales. Pero también sábanas diarias o quincenales o anuales. Además, este código agrega un comentario a las filas que no se transfirieron porque no se encontró la hoja correspondiente. De esta manera, puede ver de inmediato si la ortografía de una hoja está desactivada.

El siguiente screencast es una breve demostración del código:

enter image description here

Tenga en count que la hoja de la hoja maestra (que contiene todos los datos a transferir) debe coincidir con el nombre dado en el código. De lo contrario, VBA no sabe de dónde transferir los datos. También tenga en count que la línea con sheet6 primero no se transfiere ya que no hay hoja para ella. Pero tan pronto como creo una nueva hoja con el nombre sheet6 las palabras de código son correctas y también transfiere esta línea.

El único problema obvio con su código es que no está moviendo la selección después de pegar. En la hoja de destino, debe pasar a la siguiente fila después de pegar una. De lo contrario, cada nueva operación de pegado sobrescribirá el pegado anterior.

Evite utilizar selección y selección.copy, le causará muchos problemas, simplemente declare todo antes de comenzar a operar con range y use el método de la Clase de Rango para copyr / pegar en otra hoja previamente declarada, para que no haya necesidad de moverse "alnetworkingedor de la hoja" para copyr y pegar como lo hará un ser humano. Empecemos a pensar como computadora, él ya tiene en su memory todo lo que necesita para trabajar, ¡así que úsala!

Te aconsejo que declares cada object antes de comenzar a escribir código en VBA para que puedas get la propiedad y el método de ese object (con el intellisense, solo haz un punto después del nombre del object y VBA te mostrará todo lo que necesites), ej. el object Range tiene un método "COPY" que también tiene un parámetro DESTINATION como rangee que puede usar para mover el range de un punto a otro.

Aquí está el ejemplo en tu caso:

 Option Explicit Sub test2() 'SPECIFY OPTION EXPLICIT TO DON'T MISS ANY DECLARATION Dim ws_Master As Worksheet 'Master Worksheet Dim rng As Range 'range to iterate Dim cell As Range 'cell for iteration Dim ws_1xDaily As Worksheet 'Worksheet for daily data Dim ws_1xMonthly As Worksheet 'Worksheet for monthly data Dim i As Integer, j As Integer 'Integer for parsing 'END DECLARATION 'Sheets and range object creation Set ws_Master = ThisWorkbook.Sheets("Master Vitals Data") Set rng = ws_Master.Range("D1:D" & ws_Master.Range("D" & Rows.Count).End(xlUp).Row) 'This will get the last row of the Range D:D so we can iterate until last row Set ws_1xDaily = ThisWorkbook.Sheets("1x Daily All") Set ws_1xMonthly = ThisWorkbook.Sheets("1x Monthly All") 'End 'That's all you have to do now is just copy a range to another range, just few line of code in a for each loop: i = 1 'to remember the last row we used in the daily sheet j = 1 'same as before but for the monthly sheet For Each cell In rng If cell.Value = "1x Daily AM" Then cell.EntireRow.Copy Destination:=ws_1xDaily.Range("A" & i): i = i + 1 If cell.Value = "1x Monthly" Then cell.EntireRow.Copy Destination:=ws_1xMonthly.Range("A" & j): j = j + 1 Next cell 'End End Sub 

Si no es más eficiente, puede usar el método .Find del object Range para search cada celda que contenga lo que está buscando, en el range "D: D", sin especificar la última fila y sin iterar la celda vacía también. ¡Ve a echar un vistazo a ese método!

Aquí está el ejemplo de los events diarios con el método .Find:

 Sub test2() 'SPECIFY OPTION EXPLICIT TO DON'T MISS ANY DECLARATION Dim ws_Master As Worksheet 'Master Worksheet Dim rng As Range 'range to iterate Dim cell As Range 'cell for iteration Dim ws_1xDaily As Worksheet 'Worksheet for daily data Dim ws_1xMonthly As Worksheet 'Worksheet for monthly data Dim firstAddress As String Dim toCopyRng As Range 'END DECLARATION 'Sheets and range object creation Set ws_Master = ThisWorkbook.Sheets("Master Vitals Data") Set rng = ws_Master.Range("D:D") Set ws_1xDaily = ThisWorkbook.Sheets("1x Daily All") Set ws_1xMonthly = ThisWorkbook.Sheets("1x Monthly All") i = 1 'to remember the last row we used in the daily sheet Set toCopyRng = rng.Find("1x Daily AM", LookIn:=xlValues) If Not toCopyRng Is Nothing Then firstAddress = toCopyRng.Address Do toCopyRng.EntireRow.Copy Destination:=ws_1xDaily.Range("A" & i): i = i + 1 'copy and increment row of the daily sheet Set toCopyRng = rng.FindNext(toCopyRng) Loop While Not toCopyRng Is Nothing And toCopyRng.Address <> firstAddress End If End Sub