Anónimo
No trabaja!
No puedo hacer trabajar esta macro.
Tengo 5 columnas con diferente num. De cantidades y a casi siempre me tengo que saltar una o más columnas la cuestión es que solo trabaja bien si están llenas con el mismo numero de cantidades. En la sexta las necesito una debajo de otra aunque este alguna vacía necesito que queden seguidas.
Sub Copiar_Celdasimportes()
Sheets("Hoja1").Unprotect
Dim Columna As Integer
Dim FilaAgregar As Integer
Dim Recorrer As Integer
Dim NumDatos As Integer
FilaAgregar = 0
For Columna = 19 To 23 '1 to 5
NumDatos = WorksheetFunction.CountA(Range(Cells(1, Columna), Cells(500, Columna))) '500
'NumDatos = WorksheetFunction.CountA(Range(Cells(1, 1), Cells(65536, 1))) '65536
For Recorrer = 1 To NumDatos
If Not IsEmpty(Cells(Recorrer, Columna)) Then
FilaAgregar = FilaAgregar + 1
Cells(FilaAgregar, 29) = Cells(Recorrer, Columna) '6 '29
End If
Next Recorrer
Next Columna
Sheets("Hoja1").Protect
End Sub
Espero me ayudes con esta macro o una nueva que pueda usar gracias.
Tengo 5 columnas con diferente num. De cantidades y a casi siempre me tengo que saltar una o más columnas la cuestión es que solo trabaja bien si están llenas con el mismo numero de cantidades. En la sexta las necesito una debajo de otra aunque este alguna vacía necesito que queden seguidas.
Sub Copiar_Celdasimportes()
Sheets("Hoja1").Unprotect
Dim Columna As Integer
Dim FilaAgregar As Integer
Dim Recorrer As Integer
Dim NumDatos As Integer
FilaAgregar = 0
For Columna = 19 To 23 '1 to 5
NumDatos = WorksheetFunction.CountA(Range(Cells(1, Columna), Cells(500, Columna))) '500
'NumDatos = WorksheetFunction.CountA(Range(Cells(1, 1), Cells(65536, 1))) '65536
For Recorrer = 1 To NumDatos
If Not IsEmpty(Cells(Recorrer, Columna)) Then
FilaAgregar = FilaAgregar + 1
Cells(FilaAgregar, 29) = Cells(Recorrer, Columna) '6 '29
End If
Next Recorrer
Next Columna
Sheets("Hoja1").Protect
End Sub
Espero me ayudes con esta macro o una nueva que pueda usar gracias.
1 Respuesta
Respuesta de jgirj
1
Ya encontré la falla.
Aquí esta el código
Sub Copiar_Celdasimportes()
Sheets("Hoja1").Unprotect
Dim Columna As Integer
Dim FilaAgregar As Integer
Dim Recorrer As Integer
Dim NumDatos As Integer
Dim Encontrados As Long
FilaAgregar = 0
Range("AC:AC").ClearContents 'Limpia el rago de salida
For Columna = 19 To 23 '1 to 5
NumDatos = WorksheetFunction.CountA(Range(Cells(1, Columna), Cells(65536, Columna)))
Encontrados = 0
Recorrer = 0
Do While Encontrados < NumDatos
Recorrer = Recorrer + 1
If Not IsEmpty(Cells(Recorrer, Columna)) Then
Encontrados = Encontrados + 1
FilaAgregar = FilaAgregar + 1
Cells(FilaAgregar, 29) = Cells(Recorrer, Columna)
End If
Loop
Next Columna
Sheets("Hoja1").Protect
End Sub
Ya lo ensayé y funcionó a la perfección.
Aquí esta el código
Sub Copiar_Celdasimportes()
Sheets("Hoja1").Unprotect
Dim Columna As Integer
Dim FilaAgregar As Integer
Dim Recorrer As Integer
Dim NumDatos As Integer
Dim Encontrados As Long
FilaAgregar = 0
Range("AC:AC").ClearContents 'Limpia el rago de salida
For Columna = 19 To 23 '1 to 5
NumDatos = WorksheetFunction.CountA(Range(Cells(1, Columna), Cells(65536, Columna)))
Encontrados = 0
Recorrer = 0
Do While Encontrados < NumDatos
Recorrer = Recorrer + 1
If Not IsEmpty(Cells(Recorrer, Columna)) Then
Encontrados = Encontrados + 1
FilaAgregar = FilaAgregar + 1
Cells(FilaAgregar, 29) = Cells(Recorrer, Columna)
End If
Loop
Next Columna
Sheets("Hoja1").Protect
End Sub
Ya lo ensayé y funcionó a la perfección.