Ayuda para dividir libro excel
Publicado por Jorge (1 intervención) el 23/10/2017 16:45:12
Hola, muy buenos días.
Estoy haciendo una macro que lo que hace es recorrerse todas las hojas del libro menos la primera para eliminar todos los valores de la columna A que no sean el nombre de la delegación X o espacio en blanco. Tengo definido el nombre de la delegación en la hoja valores, celda A4.
Quería ampliar ese rango de valores para meter 20 delegaciones distintas y me guardase una copia del propio archivo con el nombre de la delegación en la propia carpeta donde se encuentra el archivo base
Es decir, el objetivo final es dividir el fichero base en 20 subarchivos con la información de cada delegación.
Hasta ahora lo que he programado es esto:
Os dejo un ficherito donde se puede hacer una prueba. La macro se encuentra en "This Workbook"
Estoy un poco bloqueado con el asunto, os estaría plenamente agradecido si me pudieséis echar una mano con el asunto.
Muchas gracias
Estoy haciendo una macro que lo que hace es recorrerse todas las hojas del libro menos la primera para eliminar todos los valores de la columna A que no sean el nombre de la delegación X o espacio en blanco. Tengo definido el nombre de la delegación en la hoja valores, celda A4.
Quería ampliar ese rango de valores para meter 20 delegaciones distintas y me guardase una copia del propio archivo con el nombre de la delegación en la propia carpeta donde se encuentra el archivo base
Es decir, el objetivo final es dividir el fichero base en 20 subarchivos con la información de cada delegación.
Hasta ahora lo que he programado es esto:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Option Explicit
Sub BorrarDelegacion()
Dim i As Byte
Dim RangoFuente As Range
Dim RangoBorrar As Range
Dim Celda As Range
Dim Primero As Boolean
Dim Delegacion As Range
Set Delegacion = Worksheets("Valores").Range("A4")
'Hacemos un For para recorrer todas las delegaciones
' Esto es lo que estoy haciendo. para Set RangoDelegacion = Worksheets("Valores").
' For Each Delegacion In RangoDelegacion
'Hacemos un For para recorrer todas las hojas desde la segunda hoja
For i = 2 To ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets(i).Select
On Error Resume Next
'Dentro de la hoja activa recorremos todas las celdas
Set RangoFuente = Range("A4:A" & Range("A65536").End(xlUp).Row)
Primero = TrueFor Each Celda In RangoFuente
'Borramos todas las que no coincidan con la delegación de turno o espacio en blanco
If (Celda.Value <> Delegacion And Celda.Value <> "") Then
If Primero Then
Set RangoBorrar = Celda.EntireRow
Primero = FalseElse
Set RangoBorrar = Union(RangoBorrar, Celda.EntireRow)
End If
End If
Next
RangoBorrar.DeleteNext
'Next
End Sub
Os dejo un ficherito donde se puede hacer una prueba. La macro se encuentra en "This Workbook"
Estoy un poco bloqueado con el asunto, os estaría plenamente agradecido si me pudieséis echar una mano con el asunto.
Muchas gracias
- Excel-ayuda-2.zip(18,7 KB)
Valora esta pregunta
0