bigpetroman

Saludos @KAITEKI, vi tu tema y tenia ganas de revisar y ver en que ayudar, pero buscando en el foro hay varios BINGOS interesantes, deberias darte una vuelta por ellos y revisar, pudieras usar uno de ellos o mejorar el tuyo, y luego pedir si te trabas en algo, uno de ellos te lleva a esta página, en el botón de excel tienes el bingo completo http://www.vicenteleon.es/ suerte

Sip, eso mismo, cambias ese numero por la columna correspondiente, me alegra que te funcione

amigo @alvaro271194, sin datos es dificil comprobar si algo funciona o no, igualmente siempre es necesario colocar un ejemplo, sin embargo creo que esto hace lo que necesitas Sub DE1A20MOV() Dim n As Integer Dim j As Integer Application.DisplayAlerts = False On Error Resume Next For j = 6 To 44 Step 2 For n = 6 To j Step 2 Range("A1").AutoFilter n, , xlFilterValues, Array(0, "12/31/2017", 0, "12/31/2016") Next n With Range("A1") .AutoFilter j + 1, "=", xlAnd Range(Cells(Rows.Count, .Column).End(xlUp), Cells(.Row + 1, Columns.Count).End(xlToLeft)).SpecialCells(12).Delete .AutoFilter End With Next j On Error GoTo 0 Application.DisplayAlerts = True End Sub Suerte, lo que realice fue simplemente RESUMIR tu macro, sin embargo seria cuestion de ver los datos y analizar si se puede hacer de otra manera

Saludos @Salva Roselló, esta linea AlMenosN_individuos = 1 colocala antes del DO y no despues y lo otro, que las variables declaralas como double, algunas las tienes como integer y da error de desbordamiento suerte

Saludos @Onotera, te dejo tu mismo archivo, con un pequeño cambio, espero que te sirva. realmente quite la parte que seleccionas todo, no es neceario estar en una hoja para copiar datos de ella, y tampoco es neceario seleccionar antes el rango que quieres copiar, simplemente lo copias y listo. y lo otro, si ya tienes una plantilla, para que estar acomodando formato de hojas luego de copiar?, alli pierdes mucho tiempo, simplemente has una copia de la hoja plantilla y listo, luego copias alli los valores que necesitas de la hoja datos. Suerte Creacion hojas obra - copia.xlsb

Saludos @cristian9209, te dejo otra opcion, muy parecida a la del maestro @Antoni Sub Explotar2() Dim mDatos() As Variant Dim mTempo() As Variant Dim j As Long Dim k As Long Application.ScreenUpdating = False Hoja2.Select Hoja2.Cells.Clear Hoja1.Rows(1).Copy Hoja2.Rows(1) ReDim mDatos(100000, 9) For X = 2 To Hoja1.Range("A" & Rows.Count).End(xlUp).Row Application.StatusBar = "Procesando fila " & X & "/" & Hoja1.Range("A" & Rows.Count).End(xlUp).Row mTempo = Hoja1.Range("A" & X & ":I" & X) plant = Split(Hoja1.Range("A" & X), ";") For p = 0 To UBound(plant) For k = 1 To UBound(mTempo, 2) mDatos(j, k - 1) = mTempo(1, k) Next k mDatos(j, 0) = plant(p) j = j + 1 Next Next Hoja2.Range("A2").Resize(j, 9) = mDatos Application.StatusBar = False End Sub

Saludos @LuisRojas, interesante el tema, aqui en el foro está un tema sobre ofuscar el codigo que tratamos algo hace tiempo Saludos

Saludos @Pirtrafilla, y el amigo @avalencia, te dejo un código de como lo haría yo Sub PegarJornadasPnetInst() ApplicationOff ' 'declaro variables Dim uf1, uf2, f1 As Long Dim IDRH, ORDEN As String Dim celda As Range, rng As Range Dim NumIDRH As Long Dim NumOrden As Integer Dim nFilaWS1 As Double 'asigno las hojas Set Ws1 = Sheets("Instaladores"): Set Ws2 = Sheets("PartePnetInst") 'ultima fila de hojas uf1 = Ws1.Range("A" & Rows.Count).End(xlUp).Row: uf2 = Ws2.Range("A" & Rows.Count).End(xlUp).Row 'Set rng = Ws2.Range("A2:A" & uf2) 'ordeno los datos de la hoja 2 para asegurar que esten ordenado por el campo Id. HR ActiveWorkbook.Worksheets("PartePnetInst").Sort.SortFields.Clear ActiveWorkbook.Worksheets("PartePnetInst").Sort.SortFields.Add Key:=Range( _ "A2:A" & uf2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal ActiveWorkbook.Worksheets("PartePnetInst").Sort.SortFields.Add Key:=Range( _ "B2:B" & uf2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal ActiveWorkbook.Worksheets("PartePnetInst").Sort.SortFields.Add Key:=Range( _ "F2:F" & uf2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("PartePnetInst").Sort .SetRange Range("A1:J" & uf2) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'recorro cada fila de la hoja ws2 NumIDRH = 0 NumOrden = 0 For Each celda In Ws2.Range("A2:A" & uf2) 'cada vez que cambie el campo Id. HR, o el ORDEN busco la fila respectiva en la hoja 1 If CLng(celda.Value) <> NumIDRH Or CLng(celda.Offset(0, 1).Value) <> NumOrden Then nFilaWS1 = 0 For f1 = 7 To uf1 If CDbl(Ws1.Range("A" & f1).Value) = CLng(celda.Value) And _ CInt(Ws1.Range("B" & f1).Value) = CLng(celda.Offset(0, 1).Value) Then 'obtengo los datos necesarios, el numero de fila (NumIDRH) 'el orden (NumOrden) y la zona (zona) ya que eso NO cambia 'hasta el proximo Id. HR NumIDRH = CDbl(Ws1.Range("A" & f1).Value) NumOrden = CInt(Ws1.Range("B" & f1).Value) nFilaWS1 = f1 zona = Ws1.Cells(f1, 8) Select Case zona Case "BARNA" zona = "BS" Case "MANRESA" zona = "TM" Case "Especiales" zona = "BS" End Select Exit For End If Next f1 End If 'cargamos la información solo si se consiguio el Id. HR en la hoja 1 If nFilaWS1 <> 0 Then dia = Day(celda.Offset(0, 5).Value) 'cargamos la info en la hoja Ws1 solo si el día no es S o F If Ws1.Cells(5, dia + 9) <> "S" And Ws1.Cells(5, dia + 9) <> "F" Then 'asigno la nomenclatura segun la zona Ws1.Cells(nFilaWS1, dia + 9) = zona End If End If Next End Sub hace exactamente lo mismo que tu codigo y mucho más rápido claro, suerte. la forma que lo haces, filtrando y quitando filtros (lo haces la x cantidad de datos que tengas en la hoja "Instaladores") pues consume mucho tiempo, entonces la idea principal que aporto es simplemente ordenar los datos de la hoja "PartePnetInst" y buscas el dato en la hoja "Instaladores" solo cuando cambie el Id. HR o Orden que estes procesando. suerte

Es asi (sin en (i) ) h.Range(dato(j)).Copy h1.Range("A" & u)

ve la diferencia aqui Header:=xlYes en tu codigo tienes Header:=xlGuess en la primera le dices explicitamente que SI tienes encabezados, en la segunda, el propio Excel es quien determina si tiene o no encabezados la tabla, por lo general usa la última condición que se haya usado en el excel

Saludos @vulkatho, revisa el anexo, presiona el botón azul Ayuda excel.xlsm

no, asi tal como está, te toma las filas de cada rango/hoja, probaste?

saludos @temp01, en tu macro, donde tienes u = u +1 coloca esto u = u + h.Range(dato(j)).Rows.Count y listo, suerte

Saludos @JuanPerez, creo entender lo que necesitas sobre el array (no lo que escribiste en la hoja, que no lo analice). hacer lo que quieres directamente en el array pues estoy seguro que no se puede, es decir, insertar una línea en la posición 10 por ejemplo y que las otras se desplacen hacia abajo (o una posición en el array) no se puede. sin embargo puedes hacer algo relativamente fácil, utiliza una columna de tu array como un ID que identifique cada línea (fila) en el mismo ejemplo si deseas insertar una nueva linea en la posicion 11, pues agregas la información al final del array y le colocas como ID el 10a por decir algo (10 porque está despues del 10, y el a para indicar que es otra linea) luego al final ordenas tu array por ese Id, y de esa forma todas las lineas te quedaran en la posición que tu necesitas y y listo, cuando la pases nuevente al excel estaran en el orden que las necesitas. espero que me haya explicado bien, suerte