Saltar al contenido

COPIAR RANGO DE DATOS SEGUN CONDICION


Recommended Posts

Hola amigos como estan! 

ando con una inquietud hace días que me mire todos los videos que encontre y no logro resolver un punto importante en  mi proyecto.

Tengo dos Archivos excel: Datos - Abastecimientos2 y Autorizaciones., ambos archivos tienen una hoja llamada "Datos" 

En el archivo de Datos - Abastecimientos, en la Hoja datos, van ingresando datos a los cuales se le agrega el valor = "Prespuestado" una vez que se hice la busqueda de precios. 

Lo que estaba intentando con el modulo 1 es que me busque todos los datos de esa hoja y  me copie solo las filas que cumplen la condicion de tener la palabra "Presupuestado".  y me las pegue en la Hoja Datos del archivo Autorizaciones.

Logre que me abra el archivo y copie los formatos he hice otras pruebas y me copiaba solo el ultimo valor encontrado ... 

les comparto el codigo... que estaba probando y no me funciona y los dos archivos.

Sub buscar_ultpedido()
Dim ufila6 As String, ufila7 As String
Dim rango As Range
Dim KPIdestino As Worksheet, MSTorigen As Worksheet, Plant As Range
Dim compID As Range
Dim i As Long
Dim primera As Variant
Dim celda As Range
Dim poblacion As String
Dim palabraBuscada As String

Application.ScreenUpdating = False

Workbooks.Open (ActiveWorkbook.Path & "\Autorizaciones.xlsm")

Set KPIdestino = Workbooks("Autorizaciones.xlsm").Worksheets("Datos")
ThisWorkbook.Activate

Set MSTorigen = Workbooks("Datos - Abastecimientos2.xlsm").Worksheets("Datos")

palabraBuscada = "PRESUPUESTADO"
ufila6 = MSTorigen.Cells(Rows.Count, 1).End(xlUp).Row
If ufila6 < 2 Then ufila6 = 2

ufila7 = KPIdestino.Cells(Rows.Count, 1).End(xlUp).Row + 1
If ufila7 < 2 Then ufila7 = 2


'If MSTorigen.Cells(ufila6, 11) = palabraBuscada Then
     For i = 2 To ufila6
        j = Hoja1.Cells(i, 1).Row
        Set rango = MSTorigen.Range("A" & j & ":K" & ufila6)
            If rango hoja1.Range("A" & j & ":K" & ufila6) = palabraBuscada Then
                rango.Copy
                KPIdestino.Range("A" & ufila7).PasteSpecial xlPasteAll
                Application.CutCopyMode = False
            End If
           ' Next
        Exit Sub
     Next
'End If
End Sub

 

Enlace a comentario
Compartir con otras webs

Lo he resulto!... les comparto el codigo por si alguno tiene un problema similar!

 

Sub Copiar_Filas_Presupuestadas(): On Error Resume Next

Dim ufila6 As String, ufila7 As String
Dim KPIdestino As Worksheet, MSTorigen As Worksheet, Plant As Range
Dim i As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Workbooks.Open (ActiveWorkbook.Path & "\Autorizaciones.xlsm")

Set KPIdestino = Workbooks("Autorizaciones.xlsm").Worksheets("Datos")
ThisWorkbook.Activate

Set MSTorigen = Workbooks("Datos - Abastecimientos.xlsm").Worksheets("Presupuestos")

Hoja2.Activate

j = 2 ' variable inicial
ufila6 = MSTorigen.Cells(Rows.Count, 1).End(xlUp).Row ' ultima fila de datos origen
ufila7 = KPIdestino.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To ufila6
    ' comprobacion de estado
        If Cells(i, "I").Value = "PRESUPUESTADO" Then
            'Copia la fila entera y la pega.
            Range(Cells(i, "A"), Cells(i, "U")).Copy Destination:=KPIdestino.Range("A" & j)
            ' Aumenta la variable para que cuando encuentre una nueva fila con la condicion me la copie
            j = j + 1
        End If
    Next
'Guarda los cambios y cierra el libro    
Workbooks("Autorizaciones.xlsm").Close SaveChanges:=True
Application.CutCopyMode = False
Application.DisplayAlerts = True

End Sub

buena semana para todos!

 

Para mi el tema esta cerrado! besos!

Enlace a comentario
Compartir con otras webs

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.