Crear dos hojas de acuerdo a ciertas condiciones
Eh estado dando vueltas con este problema que hago diario y necesito ayuda de un experto. Por que no se nada de cómo programar ojala alguien me lea y me ayude. Todo esto es en excel. Quiero una macro ya que diario hago lo mismo. Muchas gracias y espero me haga entender en lo que necesito
1.- Tengo una hoja de datos mi hoja se llama base. En esta hoja que se llama base quiero crear dos hojas con las siguientes condiciones
- Todos las filas que tengan texto C (columna A)código 10 (columna L), Número que empieza con los primeros 4 números 1111 (columna H)y área 01 (columna S) copiar y crear una hoja que se llame construcción con toda esta información.
La segunda hoja todas las filas que tengan texto T (columna A)código 20 (columna L) Número que empieza con los primeros 4 números 2222(columna H) y el área diferente de 01 (columna S)crear una hoja que se llame "detalle" con toda esta información.
Espero alguien me ayude por que esto me genera mucho trabajo retroceso y tiempo.
1 Respuesta
Te anexo la macro
Sub CrearHojas()
'Por.Dante Amor
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set h1 = Sheets("base")
n2 = "construccion"
n3 = "detalle"
'
For Each h In Sheets
If UCase(h.Name) = UCase("construccion") Then
existe2 = True
Set h2 = Sheets(n2)
h2.Cells.Clear
End If
If UCase(h.Name) = UCase("detalle") Then
existe3 = True
Set h3 = Sheets(n3)
h3.Cells.Clear
End If
Next
'
If existe2 = False Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = n2
Set h2 = Sheets(n2)
End If
If existe3 = False Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = n3
Set h3 = Sheets(n3)
End If
'
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "A") = "C" And _
Left(h1.Cells(i, "H"), 4) = "1111" And _
h1.Cells(i, "L") = "10" And _
h1.Cells(i, "S") = "01" Then
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Rows(i).Copy h2.Rows(u2)
End If
'
If h1.Cells(i, "A") = "T" And _
Left(h1.Cells(i, "H"), 4) = "2222" And _
h1.Cells(i, "L") = "20" And _
h1.Cells(i, "S") <> "01" Then
u3 = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Rows(i).Copy h3.Rows(u3)
End If
Next
MsgBox "Terminado", vbInformation
End Sub
Dante me vas a colgar :( pero te puse mal los datos de lo que quería :( es que como es mucho problema por eso hasta para mi es difícil mira:
Te coloco una imagen de lo que necesito es muy complicado por favor ayúdame que este tema me esta volviendo loca
Perdoname y ayúdame por favor :(
Te juro que no te vuelvo a molestar es mi complicación todos los días. Te vas a ir al cielo
Te anexo la macro actualizada
Sub CrearHojas()
'Por.Dante Amor
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set h1 = Sheets("base")
n2 = "construccion"
n3 = "detalle"
'
For Each h In Sheets
If UCase(h.Name) = UCase("construccion") Then
existe2 = True
Set h2 = Sheets(n2)
h2.Cells.Clear
End If
If UCase(h.Name) = UCase("detalle") Then
existe3 = True
Set h3 = Sheets(n3)
h3.Cells.Clear
End If
Next
'
If existe2 = False Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = n2
Set h2 = Sheets(n2)
End If
If existe3 = False Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = n3
Set h3 = Sheets(n3)
End If
'
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
If (h1.Cells(i, "A") = "C" And _
Left(h1.Cells(i, "H"), 4) = "1111" And _
h1.Cells(i, "L") = "10" And _
h1.Cells(i, "S") = "01") Or _
(h1.Cells(i, "A") = "T" And _
Left(h1.Cells(i, "H"), 4) = "2222" And _
h1.Cells(i, "L") = "20" And _
h1.Cells(i, "S") = "01") Then
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Rows(i).Copy h2.Rows(u2)
End If
'
If (h1.Cells(i, "A") = "C" And _
Left(h1.Cells(i, "H"), 4) = "1111" And _
h1.Cells(i, "L") = "10" And _
h1.Cells(i, "S") <> "01") Or _
(h1.Cells(i, "A") = "T" And _
Left(h1.Cells(i, "H"), 4) = "2222" And _
h1.Cells(i, "L") = "20" And _
h1.Cells(i, "S") <> "01") Then
u3 = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Rows(i).Copy h3.Rows(u3)
End If
Next
MsgBox "Terminado", vbInformation
End Sub
