Copiar datos en las filas subsiguientes
Todo Expertos. Tengo la siguiente macro y me gustaría que los datos pasados de la hoja "plantillajugadores" pegue los datos en la próxima fila vacía de la hoja destino dado por el combobox y no lo sobrescriba
Sub Pasar_ID()
'busca "Verdadero" copia y pega
Sheets("PlantillaJugadores").Select
ufila = Range("j" & Rows.Count).End(xlUp).Row 'última fila con datos de la columna I
col = Columns("j").Column 'número de columna que representa la letra I
existe = False
If ActiveSheet.ComboBox1 = "" Then
MsgBox "Falta seleccionar la hoja destino"
Exit Sub
End If
hoja = ActiveSheet.ComboBox1
For Each h In Sheets
If h.Name = hoja Then
existe = True
Exit For
End If
Next
If existe = False Then
MsgBox "No existe la hoja destino"
Exit Sub
End If
'
k = 28
For i = 2 To ufila ' recorre toda la columna hasta la última celda con datos
If Cells(i, col) = "Verdadero" Then
'copia a la hoja destino columna b el contenido de la hoja1 columna b
Sheets(hoja).Range("a" & k) = Sheets("plantillajugadores").Range("i" & i)
k = k + 1
End If
Next 'va al siguiente registro
Sheets(hoja).Select
'MsgBox "Id cargadas correctamente"
End Sub
1 respuesta
Respuesta de Dante Amor
1
Te paso la macro actualizada:
Sub Pasar_ID()
Dim uFila As Long, col As Long, uFila2 As Long
Dim i As Long, k As Long
Dim existe As Boolean
Dim hoja As String
Dim h As Worksheet
'
'busca "Verdadero" copia y pega
Sheets("PlantillaJugadores").Select
uFila = Range("j" & Rows.Count).End(xlUp).Row 'última fila con datos de la columna I
col = Columns("j").Column 'número de columna que representa la letra I
existe = False
If ActiveSheet.ComboBox1 = "" Then
MsgBox "Falta seleccionar la hoja destino"
Exit Sub
End If
hoja = ActiveSheet.ComboBox1
For Each h In Sheets
If h.Name = hoja Then
existe = True
Exit For
End If
Next
If existe = False Then
MsgBox "No existe la hoja destino"
Exit Sub
End If
'
'k = 28
uFila2 = Sheets(hoja).Range("A" & Rows.Count).End(3).Row + 1
For i = 2 To uFila ' recorre toda la columna hasta la última celda con datos
If Cells(i, col) = "Verdadero" Then
'copia a la hoja destino columna b el contenido de la hoja1 columna b
Sheets(hoja).Range("a" & uFila2) = Sheets("plantillajugadores").Range("i" & i)
uFila2 = uFila2 + 1
End If
Next 'va al siguiente registro
Sheets(hoja).Select
'MsgBox "Id cargadas correctamente"
End Sub[No olvides valorar.
[Tienes pendiente valorar:
Colocar fórmula en columna A si celda de columna B tiene información
Te paso la macro con algunos ajuste para simplificarla.
Sub Pasar_ID()
'Act. Por Dante Amor
Dim i As Long, uFila As Long, col As Long, uFila2 As Long
Dim hoja As String
'
'busca "Verdadero" copia y pega
Sheets("PlantillaJugadores").Select
uFila = Range("J" & Rows.Count).End(xlUp).Row 'última fila con datos de la columna I
col = Columns("J").Column 'número de columna que representa la letra I
hoja = ActiveSheet.ComboBox1
'
If hoja = "" Then
MsgBox "Falta seleccionar la hoja destino"
Exit Sub
End If
If Evaluate("ISREF('" & hoja & "'!A1)") = False Then
MsgBox "No existe la hoja destino"
Exit Sub
End If
'
uFila2 = Sheets(hoja).Range("A" & Rows.Count).End(3).Row + 1
For i = 2 To uFila ' recorre toda la columna hasta la última celda con datos
If Cells(i, col) = "Verdadero" Then
'copia a la hoja destino columna b el contenido de la hoja1 columna b
Sheets(hoja).Range("A" & uFila2).Value = Sheets("plantillajugadores").Range("I" & i).Value
uFila2 = uFila2 + 1
End If
Next 'va al siguiente registro
Sheets(hoja).Select
'MsgBox "Id cargadas correctamente"
End Sub[No olvides valorar.
[Tienes pendiente valorar:
Colocar fórmula en columna A si celda de columna B tiene información
