Creación de una macro
Muy buenas: tengo que crear una macro que coja datos de dos columnas de cada una de las hojas que tengo en ese documento y las pegue en otra hoja nueva poniendo los datos de estas dos columnas y también la hoja a la que pertenecen, y no se como hacerlo...
Si necesitarías te mandaría el archivo.
Muchas gracias
Si necesitarías te mandaría el archivo.
Muchas gracias
1 respuesta
Respuesta de Cadipas spain
1
Sería interesante ver el fichero, con el fin de adecuar ma macro al fichero. Pon tu dirección de correo y nos enviamos el fichero en cuestión, ademas necesitaría que me dijeras que columnas son las que quieres copiar y como quieres que se llame la hoja nueva en la que se pegarán las columnas y en que posición quieres pegar las columnas, etc...
OK, mi mail es [email protected], dame tu dirección te adjunto el fichero y te explico todo!
Muchísimas gracias
Muchísimas gracias
El resultado es:
Private Sub CommandButton1_Click()
N = 2
Worksheets(1).Range("B7:F4000") = ""
Worksheets(1).Range("F4") = Date
CONTADORHOJAS = Sheets.Count
Do While Cells(N, 9) <> ""
VALOR = Cells(N, 9)
For X = 1 To CONTADORHOJAS
DIREC = BUSCAR(X, VALOR)
Next X
N = N + 1
Loop
End Sub
Function BUSCAR(X, VALOR)
With Worksheets(X).Range("a:a")
Set C = .Find(VALOR, LookIn:=xlValues)
If Not C Is Nothing Then
DIREC = C.Address
N = 8
Do While Worksheets(1).Cells(N, 2) <> ""
N = N + 3
Loop
Worksheets(1).Cells(N, 2) = VALOR
Worksheets(1).Cells(N + 1, 2) = Worksheets(X).Range(DIREC).Offset(1, 0)
Worksheets(1).Cells(N + 1, 4) = Worksheets(X).Range(DIREC).Offset(0, 4).End(xlDown).Offset(0, 1)
Worksheets(1).Cells(N + 1, 6) = Sheets(X).Name
End If
End With
End Function
Por favor, ciera la pregunta y valora la ayuda
Private Sub CommandButton1_Click()
N = 2
Worksheets(1).Range("B7:F4000") = ""
Worksheets(1).Range("F4") = Date
CONTADORHOJAS = Sheets.Count
Do While Cells(N, 9) <> ""
VALOR = Cells(N, 9)
For X = 1 To CONTADORHOJAS
DIREC = BUSCAR(X, VALOR)
Next X
N = N + 1
Loop
End Sub
Function BUSCAR(X, VALOR)
With Worksheets(X).Range("a:a")
Set C = .Find(VALOR, LookIn:=xlValues)
If Not C Is Nothing Then
DIREC = C.Address
N = 8
Do While Worksheets(1).Cells(N, 2) <> ""
N = N + 3
Loop
Worksheets(1).Cells(N, 2) = VALOR
Worksheets(1).Cells(N + 1, 2) = Worksheets(X).Range(DIREC).Offset(1, 0)
Worksheets(1).Cells(N + 1, 4) = Worksheets(X).Range(DIREC).Offset(0, 4).End(xlDown).Offset(0, 1)
Worksheets(1).Cells(N + 1, 6) = Sheets(X).Name
End If
End With
End Function
Por favor, ciera la pregunta y valora la ayuda
