¿Cómo copiar de una lista y pegar en otra hoja en una sola celda cada valor?
Tengo un código, lo que quiero que haga es que copie de un listado, cada una de las celdas en otra hoja en una única celda que haga lo siguiente:
Por ejemplo: de la "hoja1" range("a:a") a la hoja2 range("a2")
1. Se copie la primera y se pegue en la hoja2
2. Ejecute macro
3. Borre la celda de la hoja2
4. Se copie la siguiente celda de la hoja1
Que repita el proceso cuantas celdas con valores tenga la hoja1.
Esta es el codigo de la macro que quiere que efectue por cada celda copiada
Private Sub CommandButton1_Click()
Sheets("Files_IBNRS").Select
Range("A1").Select
Range("A1:AX46").Select
Selection.Copy
Sheets("PEGAR TEXTO").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEGAR TEXTO").Select
For Each C In Sheets("PEGAR TEXTO").Range("F2:AX46")
'Si existen valores buscar, copiar y pegar en otra hoja
If C.Value <> 0 Then
Sheets("INDIVIDUAL").Range("A3").Value = 1
Sheets("INDIVIDUAL").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets("INDIVIDUAL").Range("A" & Rows.Count).End(xlUp).Offset(0, 0).Value + 1
Sheets("INDIVIDUAL").Range("BA" & Rows. Count).End(xlUp).Offset(0, 0). Copy Sheets("INDIVIDUAL").Range("B" & Rows. Count).End(xlUp).Offset(1, 0)
Sheets("INDIVIDUAL").Range("BB" & Rows. Count).End(xlUp).Offset(0, 0). Copy Sheets("INDIVIDUAL").Range("C" & Rows. Count).End(xlUp).Offset(1, 0)
Sheets("INDIVIDUAL").Range("BC" & Rows. Count).End(xlUp).Offset(0, 0). Copy Sheets("INDIVIDUAL").Range("D" & Rows. Count).End(xlUp).Offset(1, 0)
Sheets("INDIVIDUAL").Range("BD" & Rows. Count).End(xlUp).Offset(0, 0). Copy Sheets("INDIVIDUAL").Range("E" & Rows. Count).End(xlUp).Offset(1, 0)
Sheets("INDIVIDUAL").Range("BE" & Rows. Count).End(xlUp).Offset(0, 0). Copy Sheets("INDIVIDUAL").Range("J" & Rows. Count).End(xlUp).Offset(1, 0)
'seleccionar rango encontrados para celdas en otra hoja
C.Copy Sheets("INDIVIDUAL").Range("H" & Rows. Count).End(xlUp).Offset(1, 0)
C.End(xlUp).Copy Sheets("INDIVIDUAL").Range("i" & Rows.Count).End(xlUp).Offset(1, 0)
C.End(xlToLeft).Offset(0, 1).Copy Sheets("INDIVIDUAL").Range("G" & Rows.Count).End(xlUp).Offset(1, 0)
Sheets("1_Input_Base_WorkFlow").Range("A2").Value = 1
Sheets("1_Input_Base_WorkFlow").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheets("1_Input_Base_WorkFlow").Range("A" & Rows.Count).End(xlUp).Offset(0, 0).Value + 1
End If
Next
MsgBox "Se encontraron y trasladaron valores"
Sheets("INDIVIDUAL").Select
Range("B3:J3").Select
Range(Selection, Selection.End(xlDown)).Copy
Sheets("1_Input_Base_WorkFlow").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Sheets("1_Input_Base_WorkFlow").Select
Range("A" & Rows.Count).End(xlUp).Offset(0, 0).ClearContents
End Sub
1 Respuesta
H o l a:
Haber si entendí bien, lo que necesitas es pasar cada uno de los datos de la hoja1, columna "A" a la hoja2, ¿celda A2 y por cada dato que pase se ejecute tu macro "CommandButton1_Click"?
Si es así, entonces pon la siguiente macro en un módulo:
Sub CopiarLista()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
h2.[A2] = h1.Cells(i, "A")
Call CommandButton1_Click
Next
MsgBox "Se copió la lista"
End SubEjecuta esta macro y por cada celda que se pase de la hoja1 a la hoja2 se ejecutará tu macro "CommandButton1_Click".
Prueba y me comentas.
':) ':)
Si, pero el dato que pasa de la hoja1 a la hoja2, el rango de la hoja2 es uno solo luego la idea es que en el mismo rango se colequen las siguientes y cada vez que eso ocurre ejecute la macro.
Disculpa, pero no entiendo.
Podrías explicarlo con ejemplos y con imágenes de lo que tienes en la hoja1 y de lo que esperas en la hoja2.
