Si cumple condición copiar toda la fila en HOja1 y pegarla en Hoja2
Tengo una base de datos que selecciona bombas, la misma funciona genial y hace todo lo que tiene que hace el tema es que me ha quedado muy largo y no es solo eso sino que también si sigo completando el macros se va a hacer eterno, porque le voy asignando cada valor de celda a una variable y a esa la copio en hoja 2, el tema es que tengo 33 columnas, así que como verán es gigante y por ende lento. Yo copio hasta el valor 17, pero ya no quiero seguir nombrando variables e ir pegándolas una por una.
Yo tengo un If y si este se cumple lo que quiero es que tome toda la celda, esta en hoja1, la copie valla a la hoja2 y la pegue a partir de la fila A10.
1 respuesta
Ahora te copio lo que quiero arreglar, te copio desde el if hasta el end if. La idea es que cumplida la condicion copie toda la celda y la pegue en la hoja2 a partir de la celda A10 sin que se sobreescriban. La base de datos esta en la hoja1 y los datos arranca a partir de la A11.
If range("C4").Value >= Q1 And range("C4").Value <= Q2 And range("D4").Value >= H1 And range("D4").Value <= H2 And range("E4").Value = D1 Then
cel = cel + 1
Worksheets("Hoja1").Activate
Worksheets("Hoja1").Select
A = Worksheets(1).Cells(cont, 3).Value
Worksheets(2).Cells(cel, 3) = A
B = Worksheets(1).Cells(cont, 4).Value
Worksheets(2).Cells(cel, 4) = B
C = Worksheets(1).Cells(cont, 5).Value
Worksheets(2).Cells(cel, 5) = C
G = Worksheets(1).Cells(cont, 6).Value
Worksheets(2).Cells(cel, 6) = G
E = Worksheets(1).Cells(cont, 7).Value
Worksheets(2).Cells(cel, 7) = E
F = Worksheets(1).Cells(cont, 8).Value
Worksheets(2).Cells(cel, 8) = F
U = Worksheets(1).Cells(cont, 1).Value
Worksheets(2).Cells(cel, 1) = U
J = Worksheets(1).Cells(cont, 2).Value
Worksheets(2).Cells(cel, 2) = J
K = Worksheets(1).Cells(cont, 9).Value
Worksheets(2).Cells(cel, 9) = K
M = Worksheets(1).Cells(cont, 10).Value
Worksheets(2).Cells(cel, 10) = M
N = Worksheets(1).Cells(cont, 11).Value
Worksheets(2).Cells(cel, 11) = N
O = Worksheets(1).Cells(cont, 12).Value
Worksheets(2).Cells(cel, 12) = O
P = Worksheets(1).Cells(cont, 13).Value
Worksheets(2).Cells(cel, 13) = P
T = Worksheets(1).Cells(cont, 14).Value
Worksheets(2).Cells(cel, 14) = T
' R = Worksheets(1).Cells(cont, 15).Copy
Sheets("Hoja1").Select
Cells(cont, 15).Copy
Sheets("Hoja2").Select
Cells(cel, 15).Select
Do While Not IsEmpty(ActiveCell)
' Hacer activa la celda situada una fila por debajo de la actual
ActiveCell.Offset(1, 0).Activate
Loop
ActiveSheet.Paste
' Worksheets(2).Cells(CEL, 15) = R
S = Worksheets(1).Cells(cont, 16).Value
Worksheets(2).Cells(cel, 16) = S
AA = Worksheets(1).Cells(cont, 17).Value
Worksheets(2).Cells(cel, 17) = AA
BB = Worksheets(1).Cells(cont, 18).Value
Worksheets(2).Cells(cel, 18) = BB
CC = Worksheets(1).Cells(cont, 19).Value
Worksheets(2).Cells(cel, 19) = CC
DD = Worksheets(1).Cells(cont, 20).Value
Worksheets(2).Cells(cel, 20) = DD
EE = Worksheets(1).Cells(cont, 21).Value
Worksheets(2).Cells(cel, 21) = EE
FF = Worksheets(1).Cells(cont, 22).Value
Worksheets(2).Cells(cel, 22) = FF
GG = Worksheets(1).Cells(cont, 23).Value
Worksheets(2).Cells(cel, 23) = GG
HH = Worksheets(1).Cells(cont, 24).Value
Worksheets(2).Cells(cel, 24) = HH
II = Worksheets(1).Cells(cont, 25).Value
Worksheets(2).Cells(cel, 25) = II
Else
End If
H o l a: Sergio Jesús
Envíame tu archivo para adecuar la macro aortizsiagiegmail.com y me pones ejemplos
Email: [email protected]
