¿Cómo copiar consecutivamente de una hoja a otra?
Yo genero una orden de compra, ésta debo copiarla en otro archivo que tiene por objeto tener un registro de todas lar ordenes de compras que genero, es decir que ellas deben irse copiando una debajo de la otra, el problema es que con el procedimiento que le he dado no queda el registro de cada orden completa, si no de la ultima; de las anteriores solo quedan registrados las tres primeras filas, es decir el encabezado.
Este es el procedimiento que he dado:
Sub Send_ordre()
Sheets("Ordretabel").Unprotect
Sheets("Ordretabel").Visible = True
Sheets("Ordre").Activate
Range("B4:H44").Select
Selection.Copy
Sheets("Ordretabel").Activate
If Range("B5") = "" Then
Range("B5").Activate
ActiveSheet.Paste
Else
Range("B5").End(xlDown).Offset(1, 0).Activate
ActiveSheet.Paste
End If
Sheets("Ordre").Activate
Application.CutCopyMode = False
End Sub
Para mayor ilustración y quizás es el factor influyente, es que al copiar hay filas vacías, si no se solicitan todos los artículos, y al enviar a la siguiente hoja, le indico que active la fila inmediatamente vacía, después de B5. ¿Será esto el problema?
Como haría entonces para que las celdas con los datos totalizadores de la orden de compra aparezcan en función del numero de items solicitados, ¿y no queden como celdas fijas?
Este es el procedimiento:
Gå_til_ordre()
Sheets("Varetabel"). Activate
Range("B4"). Activate
Do
If ActiveCell.Offset(0, 3) > 0 Then
Varenummer = ActiveCell.Value
Varenavn = ActiveCell.Offset(0, 1).Value
Stykpris = ActiveCell.Offset(0, 2).Value
Antal = ActiveCell.Offset(0, 3).Value
'Para calcular la orden de compra
Sheets("Ordre"). Activate
Range("B12"). Activate
Do
ActiveCell.Offset(1, 0). Activate
Loop Until ActiveCell.Value = ""
With ActiveCell
.Offset(0, 0) = Varenummer
.Offset(0, 1) = Varenavn
.Offset(0, 2) = Stykpris
.Offset(0, 3) = Antal
.Offset(0, 4) = Stykpris * Antal
End With
Sheets("Varetabel").Activate
End If
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveCell.Value = ""
'Para sumar
Sheets("Ordre").Activate
With ActiveSheet
.Range("F38").Formula = "=Sum(F13:F34)"
.Range("B44").Formula = "=Sum(F38:F39)"
.Range("D44").Formula = "=Sum(F13:F34)*0.25"
.Range("F44").Formula = "=Sum(B44:D44)"
End With
End Sub
Vivo en Dinamarca, por ello algunas palabras en danés
1 Respuesta
H o l a:
Puedes enviarme tu archivo para ver cómo están los datos.
¿Entonces tienes 2 problemas, el primero, es copiar la orden a otra hoja; y el segundo, es poner los totales?
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “damjaa” y el título de esta pregunta.
¡Gracias! , ya te mande el archivo.
Buenas noches
H o l a:
Según entiendo, lo que tienes que enviar a la hoja "Ordretabel", es todo el pedido, lo que se hace en esos casos, los encabezados se repiten para cada registro. Lo mejor sería crear una hoja de encabezados, y otra hoja de detalle, ambas hojas se relacionarían con alguna llave, puede ser el número de orden. Pero en este caso solamente te piden que se almacene en otra hoja.
Por consiguiente, lo que hace la macro es pasar la orden a la otra hoja, considerando los datos del encabezado para cada registro.
La macro:
Sub Send_ordre()
'Act.Por.Dante Amor
Dim h1, h2, i, j
Dim sTekst As String
'Det undgår, at skærmet blinker
Application.ScreenUpdating = False
'Dette er det sidste step i processen, kunden sender ordren og ordren bliver gemt i et nyt ark
'Kunden får en meddelse om dette
Set h1 = Sheets("Ordre")
Set h2 = Sheets("Ordretabel")
h2.Unprotect
If h1.[C3] = "" Then
MsgBox "Capture Orderdatum", vbInformation, "Georg Jensen A/S"
h1.[C3].Select
Exit Sub
End If
'
j = h2.Range("B" & Rows.Count).End(xlUp).Row + 1
For i = 13 To 37
If h1.Cells(i, "B") = "" Then Exit For
h1.Range("C3:C6").Copy: h2.Cells(j, "B").PasteSpecial Paste:=xlValues, Transpose:=True
h1.Range("F6, G6").Copy: h2.Cells(j, "F").PasteSpecial xlValues
h1.Range("B" & i & ":F" & i).Copy: h2.Cells(j, "H").PasteSpecial Paste:=xlValues
j = j + 1
Next
Application.CutCopyMode = False
sTekst = "Deres ordre er nu registreret i vores system" & vbNewLine & vbNewLine
sTekst = sTekst & "Vi tilstræber at behandle deres ordre så hurtigt som muligt" & vbNewLine & vbNewLine
sTekst = sTekst & "Tak fordi De valgte at handle med Georg Jensen A/S" & vbNewLine
sTekst = sTekst & "Vi ser frem til at handle med Dem igen"
MsgBox sTekst, vbInformation, "Georg Jensen A/S"
'Call Auto_Close
h1.Range("C5:C6").ClearContents
h1.Range("B13:H37").ClearContents
End Sub