por favor podrían ayudarme con la siguiente macro que no he podido lograr dar una solución.
Esta macro lo acabo de copiar de la web ya que tiene todo lo que necesito, sin embargo tiene un pequeño detalle lo cual requiero me puedan ayudar. La macro marcha bien cuando realiza la primera copia, sin embargo, cuando se importa una segunda información la macro no logra copiar los datos en la fila continua... por favor podrían ayudarme a corregir ese detalle.
Gracias.
Dim Q&
Set ws1 = ActiveSheet
On Error Resume Next
ws2 = "Selecciona el libro a procesar."
MsgBox ws2, vbOKOnly
ws2 = Application.GetOpenFilename(Title:=ws2)
If ws2 = False Then Exit Sub
On Error GoTo 0
Set ws2 = Workbooks.Open(ws2, ReadOnly:=True).Sheets(1)
If [c12] = "" Then
MsgBox "Libro sin información."
GoTo Fin
End If
ReDim Mat(1 To 4)
Q = Range([a6], Cells(Rows.Count, "c").End(xlUp)).Rows.Count
Mat(1) = Application.Transpose(ws2.[a6].Resize(Q))
Mat(2) = Application.Transpose(ws2.[c6].Resize(Q))
Mat(3) = Application.Transpose(ws2.[d6].Resize(Q))
Mat(4) = Application.Transpose(ws2.[g6].Resize(Q))
ws1.[b3].Resize(Q, UBound(Mat)) = Application.Transpose(Mat)
Fin:
ws2.Parent.Close False
ws1.[a4].CurrentRegion.Columns.AutoFit
End Sub
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Buenas tardes,
por favor podrían ayudarme con la siguiente macro que no he podido lograr dar una solución.
Esta macro lo acabo de copiar de la web ya que tiene todo lo que necesito, sin embargo tiene un pequeño detalle lo cual requiero me puedan ayudar. La macro marcha bien cuando realiza la primera copia, sin embargo, cuando se importa una segunda información la macro no logra copiar los datos en la fila continua... por favor podrían ayudarme a corregir ese detalle.
Gracias.
Dim Q& Set ws1 = ActiveSheet On Error Resume Next ws2 = "Selecciona el libro a procesar." MsgBox ws2, vbOKOnly ws2 = Application.GetOpenFilename(Title:=ws2) If ws2 = False Then Exit Sub On Error GoTo 0 Set ws2 = Workbooks.Open(ws2, ReadOnly:=True).Sheets(1) If [c12] = "" Then MsgBox "Libro sin información." GoTo Fin End If ReDim Mat(1 To 4) Q = Range([a6], Cells(Rows.Count, "c").End(xlUp)).Rows.Count Mat(1) = Application.Transpose(ws2.[a6].Resize(Q)) Mat(2) = Application.Transpose(ws2.[c6].Resize(Q)) Mat(3) = Application.Transpose(ws2.[d6].Resize(Q)) Mat(4) = Application.Transpose(ws2.[g6].Resize(Q)) ws1.[b3].Resize(Q, UBound(Mat)) = Application.Transpose(Mat) Fin: ws2.Parent.Close False ws1.[a4].CurrentRegion.Columns.AutoFit End Sub