Copiado de columnas con matriz

[CECILIO]

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

[Haplox]

@CECILIO , ¿solo era eso lo que no te funcionaba? ?

Te dejo una solución. Fíjate en las variables cómo están dimensionadas (como lo tenías no te debía funcionar nada) y en código, que está comentado la parte importante.

Por tu código inicial he dado por hecho que querías sustituir los datos, no ponerlos al final

Copia de 0 PD CARGA POL 20 07-2.xlsm

[CECILIO]

Solo hay un detalle que en el proceso de pegado no me los pega en las columnas que necesito pero ademas me borra los títulos de la fila

3,

 

 

[Haplox]

Hace 2 horas, CECILIO dijo:

no me los pega en las columnas que necesito pero ademas me borra los títulos de la fila

Pero eso ya es fácil que lo qrregles tú ¿No? En un archivo con tantas columnas solo tú sabes cómo y dónde pegarlos, pero vamos... lo más lógico es copiar/pegar en un mismo sitio.

Para lo de los títulos mira el rango que hay en la línea con "ws1.Range(aqui).ClearContents"