Excel-vba:¿Creación de hojas + Copiar y pegar datos de una hoja central (base de datos) a la hoja respectiva?

Del foro,
Recurro a ustedes por un tema de ayuda EXCEL/VBA. En si, estoy creando un documento excel que me permitirá automatizar algunas fases de mi trabajo diario en la empresa donde laboro.
La idea del documento excel es:
Una base de datos principal : Hoja "FX Deals Trasacted"

Una hoja de utilización de Macros: Hoja " Macro"
Las hojas T42, T43, T44... Representan cada subsidiaria que se crean al ejecutarse la macro/boton (Creation onglet filiale)
El objetivo del documento es que la base de datos:
La base de datos "FX Deals Transacted contiene la lista de deals realizados por el total de subsidiarias de la empresa. La columna "U" de esa misma hoja se aprecian la subisidiaria y su respectivo deal.
Dado el numero inmenso de deals importar, la idea es separar los deals (cada línea de la base de datos) por subsidiaria en una hoja nueva.
Para ello, cree 3 Macros:
1) Macro "Creation Onglet Filiale": Te permite crear las hojas para cada subsidiaria mediante una lista al cual se adjunta las subsidiarias --> Hoja "Macro"--> Columna B --> Fila 13, 14, 15...

2) Macro Copier données filiales:
He aqui donde tengo un problema. Esta Macro debe permitirme copiar y pegar los datos de la base de datos "FX Deals Transacted" cuando la linea cumple la condicion que es: Copiar los datos en la hoja de la subsidiaria correspondiente (Condicion: Por cada datos de la columna "U:U" = Hoja subsidiaria creada). Mi Macro en si funciona a medias, copia los datos, pero no en las hojas correspondientes segun la condicion.

Macro Copiar y pegar los datos en la hoja correspondiente (Macro que tiene error --> no copia en la hoja esperada, sino en otra)

Sub copier()

Dim cel As String
Application.ScreenUpdating = False
'en col B de hoja Total se encuentra la lista de hojas
nro = 13
For P = 4 To 60000
i = 0
j = 1
'repito el bucle hasta encontrar una celda vacía
While i = 0
nbrehoja = Sheets("Macro").Range("B" & nro)
'si encuentra una celda vacía es el fin del proceso
If nbrehoja = "" Then i = 1: Exit Sub
'incremento en 1 el nro de fila en col B
nro = nro + 1
'selecciono la hoja buscada
Sheets(nbrehoja).Select
Range("A1:XX65536").Select
Selection.ClearContents
Sheets("FX Deals Transacted").Select
Range("U4").Select
Do While ActiveCell <> ""
If ActiveCell.Offset(1, 0).Value = nbrehoja Then
Range(Cells(P, "A"), Cells(P, "V")).Copy
ActiveCell.Offset(1, 0).Select
Sheets(nbrehoja).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Sheets("FX Deals Transacted").Select
P = P + 1
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
'repito para la siguiente hoja de la columna B hoja Macro
Wend
Next
End Sub

ERROR --> No copio en la hoja T43 que es la esperada

Creo que el problema se encuentra a la hora de comparar con el boucle.
La macro de creación de Hojas que funciona bien es:

Private Sub CommandButton1_Click()

'Max lignes à tenir en compte
Max = 500

'Boucle des lignes 13 jusqu'à Max de la colonne A
For Cont = 13 To Max

'ajouter le contenu de la cellule à la variable Filiale
Filiale = Cells(Cont, 2).Value
'Si el Nombre es diferente a vacío, entonces crear la nueva hoja
If Filiale <> "" Then
On Error Resume Next
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Filiale
End If
Next Cont
Sheets("Macro").Select

End Sub

Espero haya especificado correctamente el problema, agradecería su ayuda de antemano.
Cordialemente
Javier

1 Respuesta

Respuesta

A ver cambiale el código de tu rutina sub copier() por esta otra (ejecutalo en tu hoja "Fx Deals Transacted"

Sub CopiandoHaciaOtrasHojas()

Final = Cells(Application.Rows.Count, 1).End(xlUp).Row
For i = 4 To Final
Thish = Cells(i, 21)
fila = Worksheets(Thish).Cells(65536, 1).End(xlUp).Row + 1
Cells(i, 1).Resize(1, 22).Copy Destination:=Worksheets(Thish).Cells(fila, 1)
Next i
End Sub

Me avisas si te sirve

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas