Copiar datos de una hoja de excel 2003 a otra de acuerdo con un criterio determinado y generar hojas con esos nombres
Copiar datos de una hoja de excel 2003 a otra según determinado criterio
Hola amigos, de antemano gracias por ayudarme: Tengo una hoja "DATOS" con registros cuyo primer campo, columna "B", puede tener dos variantes de un dato : FÍSICO o QUÍMICO y necesito que si el dato contenido en cada una de esas celdas es "QUIMICO", entonces, copiar el contenido de la celda contigua (C, No. Fila) en otra hoja que se llama "DATOS QUÍMICOS", y posteriormente, por cada registro (celda copiada en la Hoja DATOS QUÍMICOS", se me generé o se me cambie el nombre de las hojas contiguas (Hoja3, hoja 4, hoja 5, etc) por cada uno de los nombres que existen en la hoja "DATOS QUIMICOS". Ejemplo:
EN la hoja DATOS tengo en B1 "FISICO", B2 "FISICO", B3 "QUIMICO", B4"FISICO"... B20 QUÍMICO, y C1 "GASEOSO", C2"LIQUIDO", C3 "BARIO", C4 "SOLIDO"... En C20 "CARBONO", entonces necesito que se me me copie el contenido de C3 y C20 en la hoja QUÍMICOS (porque B3 y B20 tienen "QUIMICO"), pero sin los espacios entre las dos veces que aparece QUÍMICO en DATOS,(correspondientes a las filas intermedias), es decir que en QUÍMICOS me aparezcan BARIO en B1 y CARBONO en B2 y luego que se generé una hoja por cada nombre que aparezca en la hoja "DATOS QUIMICOS", que tenga el nombre de cada celda de la hoja DATOS QUIMICOS, es decir: que en mi libro aparecerán las hojas: DATOS, DATOS QUIMICOS", BARIO, CARBONO, etc...
Ojala que me puedan ayudar y reitero mi agradecimiento de antemano.
Saludos
Alexx
Sinaloa, México
1 Respuesta
Esto hace lo que pides:
Sub Crear_Hojas()
Dim hoja As Worksheet
'Por Marcial Castro
Set h1 = Sheets("DATOS")
Set h2 = Sheets("DATOS QUÍMICOS")
'Recorremos la hoja DATOS
For t = 1 To h1.Range("B" & Rows.Count).End(xlUp).Row
If h1.Cells(t, 2) = "QUÍMICO" Then
'Copia el valos de DATOS en DATOS QUÍMICOS'
h2.Cells(Range("B" & Rows.Count).End(xlUp).Row + 1, 2) = h1.Cells(t, 3)
'Si no existe la hoja, la crea'
On Error Resume Next
Set hoja = Sheets(h1.Cells(t, 3).Value)
If hoja Is Nothing Then
Worksheets.Add(after:=Worksheets(Sheets.Count)).Name = h1.Cells(t, 3)
End If
End If
Next t
End SubSi te ha valido la respuesta.
