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 mis archivos y 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
'mio = ActiveWorkbook.Name
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
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 mis archivos y 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 'mio = ActiveWorkbook.Name 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
Recibidas_2020_08_Facturas.xlsx 0 PD CARGA POL 20 07.xlsm