Como copiar en varias hojas con Macros
Necesito distribuir de una hoja Base a varias hojas del mismo libro según parámetro definido en hoja Variables. De la hoja Base consulto por código, en orden descendente, y lo comparo con el código de la hoja Variables, veo el motivo que tiene asignado y lo llevo a la hoja correspondiente. (Ordenadas en la hoja de destino según sean encontradas).
La copia de la hoja Base a las nuevas hojas debe hacerse mediante un botón. Si existieran antecedentes con anterioridad en las hojas de destino debe eliminarse la información (Sólo el rango utilizado A-G), para luego copiar los nuevos antecedentes.
Debe tenerse en cuenta que además de la comparación de los códigos, la consulta debe validar que sea la empresa indicada en la hoja Variables.
Hoja Base
Hoja Variables
Hoja Frutas
Hoja Fruta Seca
1 Respuesta
H o l a:
Utiliza la siguiente macro
Sub Distribuir()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Base")
Set h2 = Sheets("variables")
'
For Each h In Sheets
Select Case h.Name
Case h1.Name, h2.Name
Case Else
h.Cells.Clear
h1.Rows(1).Copy h.Rows(1)
End Select
Next
'
u = h1.Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("B").Find(h1.Cells(i, "D"), lookat:=xlWhole)
If Not b Is Nothing Then
hoja = h2.Cells(b.Row, "E")
Set h3 = Sheets(hoja)
u3 = h3.Range("D" & Rows.Count).End(xlUp).Row + 1
h1.Rows(i).Copy h3.Rows(u3)
End If
Next
Sheets("Verduras").Columns("F").Delete
MsgBox "Terminada"
End Sub
Genero la información pero me da un error 9.
Subindice fuera de intervalo.
Una consideración. Si en la hoja Base hay códigos que no están en la hoja Variables no debe hacer nada con ellos. De igual forma si el código existe en la hoja Base y existe en la hoja variables, pero en ésta no tiene hoja de destino, tampoco debe considerarlo.
H o l a:
Te anexo la macro actualizada para verificar si existe la hoja:
Sub Distribuir()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Base")
Set h2 = Sheets("variables")
'
For Each h In Sheets
Select Case h.Name
Case h1.Name, h2.Name
Case Else
h.Cells.Clear
h1.Rows(1).Copy h.Rows(1)
End Select
Next
'
u = h1.Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("B").Find(h1.Cells(i, "D"), lookat:=xlWhole)
If Not b Is Nothing Then
hoja = h2.Cells(b.Row, "E")
existe = False
For Each h In Sheets
If UCase(h.Name) = UCase(hoja) Then
existe = True
End If
Next
If existe Then
Set h3 = Sheets(hoja)
u3 = h3.Range("D" & Rows.Count).End(xlUp).Row + 1
h1.Rows(i).Copy h3.Rows(u3)
End If
End If
Next
Sheets("Verduras").Columns("F").Delete
MsgBox "Terminada"
End Sub‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
Estimado
La hoja frutas secas no me la llena y el botón que ingreso para la consulta en la hoja base me lo copia en la hoja frutas.
Revisa que el nombre de tu "hoja frutas" sea igual al nombre que pusiste en la hoja variables. Revisa si hay espacios en las palabras.
Para que no te copie el botón, presiona sobre el botón click derecho del mouse. En Tamaño y propiedades, Propiedades, selecciona No mover ni cambiar tamaño con celdas.
