Kopieren von Daten von einer Arbeitsmappe in eine andere mithilfe der Spaltenüberschrift
Hat jemand einen Code zum Kopieren von einem Excel-WB zu einem anderen, basierend auf Spaltenüberschriften?
Update: Entschuldigung an alle, ich bin neu auf dieser Seite und ich hoffe, Sie können meine Unwissenheit vergeben.
Hier ist der Code, den ich ausprobiert habe, basierend auf den Posts anderer (danke, 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
Ich erhalte in der ersten und fünften Zeile (mit Ausnahme der Leerzeichen, wenn gezählt wird) bei TargetWS.Cells den Fehler "ByRef argument type mismatch" ....
Ich habe auch dieses ... was funktioniert, aber ich muss ein paar .End (xlDown) hinzufügen, um fehlende Informationen zu berücksichtigen, damit die gesamte Spalte kopiert wird (nicht nur in die nächste Zelle MIT einem Wert). Haben Sie ein besseres System, um dies zu berücksichtigen?
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
Wie Sie sehen, muss ich für jede leere Zelle .End (xlDown) hinzufügen. Vielen Dank im Voraus für jede Hilfe, die Sie anbieten können.