Jump to content
  • 34 ¿Te resultaría interesante una carpeta sobre Python para Excelen el foro?

    1. 1. ¿Te resultaría interesante una carpeta sobre Python para Excel en el foro?


      • Sí! Me interesa
      • No me interesa.
      • Otros (Escribe tu respuesta en el tema)

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

 

Edited by roa30
Link to comment
Share on other sites

Seguramente mi error esta en como aplico el criterio de seleccion... pero no logro comprender como unir esas condiciones con el rango a copiar...

Me podrian guiar en que estoy haciendo mal?

Link to comment
Share on other sites

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!

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Create New...

Important Information

Privacy Policy