Copiado de datos usando array para columnas origen y destino
Un favor me pudieran ayudar con lo siguiente
Quisiera obtener los resultados como se encuentran en el archivo "0 PD CARGA POL 20 07.Xlsm" Hoja "RECIB", los datos los debe de extraer del archivo "Recibidas_2020_08_Facturas.xlsx, trate de introducir las columnas en matriz sin embargo debido a que mi pc es lenta y manejo muchos datos fue la razón por la que decidí introducir mis columnas en matriz tanto las columnas que estoy copiando, así como las columnas de destino, sin embargo no lo hace correctamente, adjunto mi macro para cualquier apoyo, corrección de antemano, les agradezco
Sub Macro2()
'
Application.ScreenUpdating = False
Dim ws2, ws1 As Worksheet, Mat
Dim Q&
Set ws1 = ActiveSheet
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)
Sheets("XML").Select
If [B2] = "" Then
MsgBox "Libro u Hoja sin Informacion."
End If
'ReDim Matt(1 To 58)
Q = Range([B1], Cells(Rows.Count, "b").End(xlUp)).Rows.Count
colso = Array("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", "BG")
colsd = Array("A", "B", "D", "E", "F", "G", "H", "I", "J", "K", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", "BG", "BH")
If [B2] <> "" Then
For col = LBound(colso) To UBound(colso)
For col2 = LBound(colsd) To UBound(colsd)
Cells(2, colso(col)).Resize(Q).Copy
ws1.Cells(4, colsd(col2)).Resize(Q).PasteSpecial xlPasteValues
Next
Next
End If
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
1 Respuesta
Respuesta de Dante Amor
2
Prueba lo siguiente:
Sub Macro2()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wb As Workbook
Dim libro As Variant, colso As Variant, colsd As Variant
Dim i As Long, lr As Long
'
Application.ScreenUpdating = False
'
Set ws1 = ActiveSheet
libro = Application.GetOpenFilename(Title:="Selecciona el libro a procesar")
If libro = False Then Exit Sub
Set wb = Workbooks.Open(libro)
Set ws2 = wb.Sheets("XML")
colso = Array("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", _
"Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", _
"AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", _
"AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", _
"BC", "BD", "BE", "BF", "BG")
colsd = Array("A", "B", "D", "E", "F", "G", "H", "I", "J", "K", "M", "N", "O", "P", "Q", _
"R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", _
"AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ", _
"AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", _
"BD", "BE", "BF", "BG", "BH")
'
If ws2.[B2] = "" Then
MsgBox "Libro u Hoja sin Informacion."
Exit Sub
End If
lr = ws2.Range("B" & Rows.Count).End(3).Row - 1
'
For i = 0 To UBound(colso)
ws1.Range(colsd(i) & 4).Resize(lr).Value = ws2.Range(colso(i) & 2).Resize(lr).Value
Next
'
Application.ScreenUpdating = True
End Sub
