Copie datos de un libro de trabajo a otro usando el encabezado de columna
¿Alguien tiene un código para copiar de un excel WB a otro basado en encabezados de columna?
Actualización: Perdón por todos, soy nuevo en este sitio y espero que puedan perdonar mi ignorancia.
Aquí está el código que he probado, basado en las publicaciones de otros (¡gracias, Simon!).
Sub copy_cols()
Set SourceWS = Workbooks("Source.xlsx").Worksheets(1)
Set TargetWS = Workbooks("Business Loader V7.1.xlsx").Worksheets(2)
For Each rgCell In SourceWS.Range("A1:AX1")
TargetWS.Columns(GetColumn(TargetWS, rgCell.Value)) = _
SourceWS.Columns(GetColumn(SourceWS, rgCell.Value))
' I Have also tried this with no success:
' TargetWS.Columns(GetColumn(TargetWS, rgCell.Value)) = _
SourceWS.Columns(GetColumn(SourceWS, rgCell.Column))
End Sub
Function GetColumn(GCSheet As Worksheet, ColumnName As String) As Integer
Dim intCol As Integer
On Error Resume Next
intCol = Application.WorksheetFunction.Match(ColumnName, GCSheet.Rows(1), 0)
If Err.Number <> 0 Then
GetColumn = 0
Else
GetColumn = intCol
End If
End Function
Recibo un error "No coinciden los tipos de argumento ByRef" en la primera y quinta línea (excluyendo los espacios al contar) en TargetWS.Cells ...
También tengo esto ... que funciona, pero tengo que agregar un montón de .End (xlDown) para tener en cuenta la información que falta, por lo que se copia toda la columna (no solo en la siguiente celda CON un valor). ¿Tiene un mejor sistema para dar cuenta de esto?
Sub CopyHeaders()
Dim header As Range, headers As Range
Set SourceWS = Workbooks("Source.xlsx").Worksheets(1)
Set TargetWS = Workbooks("Business Loader V7.1.xlsx").Worksheets(2)
Set headers = SourceWS.Range("A1:AX1")
For Each header In headers
If GetHeaderColumn(header.Value) > 0 Then
Range(header.Offset(1, 0), header.End(xlDown).End(xlDown).End(xlDown).End(xlDown).End(xlDown).End(xlDown).End(xlDown).End(xlDown).End(xlDown)).Copy Destination:=TargetWS.Cells(2, GetHeaderColumn(header.Value)) '.End(xlDown).Offset(1, 0)
End If
Next
Como puede ver, tengo que agregar .End (xlDown) para cada celda en blanco. Gracias de antemano por cualquier ayuda que pueda ofrecer.