Macro Separar Datos Duda Cambiar Range
Hace tiempo muy amablemente Dante amor me hizo la siguiente Macro. Desde entonces he intentado aprender VBA para excel, y bueno aún tengo mucho que aprender y muchas limitaciones.
Mi duda es que quiero cambiar el RANGE que copia la macro separar datos, ya que me gustaría que todas las cosas que escribo fuera de esa "selección" que yo elijo, o escribo en la macro, no salga en cada archivo individual. He probado varias formas cambiando la macro, pero en ninguna me sale bien como yo quiero. Por poner un ejemplo, me gustaria que aunque haya información en la M1, solamente me copie en los nuevos archivos que hace desde la columna D, de la A1:E10 por ejemplo
Sub Separar_Datos()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set H1 = Sheets("Hoja1") 'hoja con registros
Set h2 = Sheets("temp") 'hoja temporal
h2.Cells.Clear
col = "D"
n = Columns(col).Column
If H1.AutoFilterMode Then H1.AutoFilterMode = False
H1.Columns(col).Copy h2.[A1]
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
h2.Range("A1:A" & u2).RemoveDuplicates Columns:=1, Header:=xlYes
'
ruta = H1.Range("G2") 'AÑADIR RUTA!!!!
If ruta = "" Then
ruta = l1.Path & "\"
Else
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
If Dir(ruta, vbDirectory) = "" Then
ruta = l1.Path & "\"
End If
End If
For I = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
grupo = h2.Cells(I, "A")
If H1.AutoFilterMode Then H1.AutoFilterMode = False
u1 = H1.Range("A1:D4").End(xlUp).Row
H1.Range("A1:D4").AutoFilter Field:=n, Criteria1:=grupo
'u3 = h1.Range("A" & Rows.Count).End(xlUp).Row
Set l2 = Workbooks.Add
Set h21 = l2.Sheets(1)
'h1.Range("A1:Z" & u1).Copy h21.[A1]
H1.Cells.Copy h21.Range("A1")
l2.SaveAs ruta & grupo
l2.Close
Next
If H1.AutoFilterMode Then H1.AutoFilterMode = False
MsgBox "Archivos creados"
End Sub
1 Respuesta
Quedaría así:
Sub Separar_Datos()
'Por Dante Amor
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = Sheets("Hoja1") 'hoja con registros
Set h2 = Sheets("temp") 'hoja temporal
h2.Cells.Clear
col = "D"
n = Columns(col).Column
If h1.AutoFilterMode Then h1.AutoFilterMode = False
h1.Columns(col).Copy h2.[A1]
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
h2.Range("A1:A" & u2).RemoveDuplicates Columns:=1, Header:=xlYes
'
ruta = h1.Range("G2") 'AÑADIR RUTA!!!!
If ruta = "" Then
ruta = l1.Path & "\"
Else
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
If Dir(ruta, vbDirectory) = "" Then
ruta = l1.Path & "\"
End If
End If
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
grupo = h2.Cells(i, "A")
If h1.AutoFilterMode Then h1.AutoFilterMode = False
u1 = h1.Range("D" & Rows.Count).End(xlUp).Row
h1.Range("A1:M" & u1).AutoFilter Field:=n, Criteria1:=grupo
Set l2 = Workbooks.Add
Set h21 = l2.Sheets(1)
u3 = h1.Range(col & Rows.Count).End(xlUp).Row
h1.Range("A1:E" & u3).Copy h21.[A1]
l2.SaveAs ruta & grupo
l2.Close
Next
If h1.AutoFilterMode Then h1.AutoFilterMode = False
MsgBox "Archivos creados"
End Subueba y me comentas. Si es lo que necesitas, r ecuerda valorar la respuesta.
Hola Dante, muchas gracias hacer exactamente lo que te pedí :)
Me podrías por favor decir que rangos cambiar para que yo pueda irla adaptando a las diferentes situaciones que me encuentre. Ya que unas veces necesito de la columna A hasta la E, pero otras puede que cambie.
He visto que has modificado esta parte:
u1 = h1.Range("D" & Rows.Count).End(xlUp).Row
h1.Range("A1:M" & u1).AutoFilter Field:=n, Criteria1:=grupo
Set l2 = Workbooks.Add
Set h21 = l2.Sheets(1)
u3 = h1.Range(col & Rows.Count).End(xlUp).Row
h1.Range("A1:E" & u3).Copy h21.[A1]Según entiendo, coge lo que hay en la D que es la columna "base" para hacer los ficheros excel, autofiltra de la A1 a la M, y luego copia en una nueva hoja, de la A1 a la E.
Si tuviera que modificar, ¿ademas de si cambiará la columna base deberian cambiar esos dos rangos?
Muchas gracias por tu ayuda
La columna base para filtrar se pone en esta parte:
Col = "D"
Entonces copio la columna base a la hoja2, te anexo más comentarios:
'lee cada grupo de la hoja 2 de la columna A
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
grupo = h2.Cells(i, "A")
If h1.AutoFilterMode Then h1.AutoFilterMode = False
'efectivamente tomo el último dato de la columna base
u1 = h1.Range(col & Rows.Count).End(xlUp).Row
'filtro desde A hasta M por el número de campo, en este caso
'en la variable n tengo el número de columna base
h1.Range("A1:M" & u1).AutoFilter Field:=n, Criteria1:=grupo
Set l2 = Workbooks.Add
Set h21 = l2.Sheets(1)
'después del filtro, obtengo la última fila, también en sobre
'a la columna base
u3 = h1.Range(col & Rows.Count).End(xlUp).Row
'en este rango selecciono lo que voy a copiar,
'en este ejemplo copio desde A1 y hasta la columna E y hasta
'la nueva fila obtenida después del filtro.
'el destino es el nuevo libro en la nueva hoja
h1.Range("A1:E" & u3).Copy h21.[A1]
l2.SaveAs ruta & grupo
l2.Close
Nextsal u dos
