Excel-Makro zum kopieren von Zeilen aus einer Datei in eine andere

Möchte ich kopieren bestimmter Spalten (A,B und E) aus einer Arbeitsmappe in eine andere. Ich schrieb das folgende Makro, mit Hilfe der coolen Leute hier bei stackoverflow, aber dieser code ist nicht kopieren die Tabelle überschriften wie "Studie Zimmer 2100E - Freitag, Nov 30 2012"

Sub CopyColumnToWorkbook()
Dim sourceColumn As Range, targetColumn As Range

Set sourceColumn = Workbooks("Source.xlsm").Worksheets(1).Columns("A:B" & lr)
Set targetColumn = Workbooks("Target.xlsm").Worksheets(1).Columns("A:B")

Set sourceColumn2 = Workbooks("Source.xlsm").Worksheets(1).Columns("E" & lr)
Set targetColumn2 = Workbooks("Target.xlsm").Worksheets(1).Columns("C")

sourceColumn.Copy Destination:=targetColumn
sourceColumn2.Copy Destination:=targetColumn2

End Sub

Dies ist die Quell-Datei:

Dies ist, was mein Aktuelles Ziel Datei: (BEARBEITET GEHÖREN KORREKTE LINK 6:58PM EST Dez 11)

Dies ist mein gewünschte Ziel Datei:

Die Quell-Datei besteht aus vielen Tabellen mit separaten Tabelle überschriften. Wie können Sie sagen, die Reihen A,B und E der Tabellen kopiert werden, aber die Tabelle überschriften nicht kopiert werden. Wie kann ich ändern, meinen code so mein Aktuelles Ziel-Datei sieht aus wie meine gewünschte Ziel-Datei? Dank

InformationsquelleAutor Amatya | 2012-12-11
  1. 2

    Der Grund, warum Sie das Ergebnis bekommen, das Sie tun, ist, dass die Kopfzeilen befinden sich verbundene Zellen, 4 Zellen breit und das kopieren/einfügen von 2 Spalten erfasst nicht die Werte aus diesen Zellen (weiß nicht warum).

    Einer umgehen, kopieren Sie die Werte ersten (über ein variant-array) und dann kopieren/einfügen der Formate.

    Dadurch wird der Header mit zusammengeführten Zellen 2 Zellen breit. Sie müssen passen Sie die Kopfzeilen nach dem Kopiervorgang.

    Beachten Sie, sollten Sie erklären alle deine Variablen

    Option Explicit ' First line in Module

Sub CopyColumnToWorkbook()
    Dim sourceColumn As Range, targetColumn As Range
    Dim sourceColumn2 As Range, targetColumn2 As Range
    Dim lr As String  ' <-- don't know what this is for, left it in as it's in your OP
    Dim rw As Range

    Set sourceColumn = Workbooks("Source.xlsm").Worksheets(1).UsedRange.Columns("A:B" & lr)
    Set targetColumn = Workbooks("Target.xlsm").Worksheets(1).Columns("A:B").Resize(sourceColumn.Rows.Count)

    ' Copy values
    targetColumn = sourceColumn.Value
    ' Copy Format
    sourceColumn.Copy
    targetColumn.PasteSpecial xlPasteFormats

    Set sourceColumn2 = Workbooks("Source.xlsm").Worksheets(1).Columns("E" & lr)
    Set targetColumn2 = Workbooks("Target.xlsm").Worksheets(1).Columns("C")
    sourceColumn2.Copy Destination:=targetColumn2

    ' Adjust Headers
    For Each rw In targetColumn.Rows
        If rw.MergeCells Then
            rw.Resize(1, 4).Merge
            ' Appy cell format to headers here if required
            rw.Font.Size = 18
            ' etc ...
        End If
    Next

End Sub
    • Vielen Dank für Ihre Antwort. Ich kann nicht glauben, dass es gedauert, bis 2014 danken Ihnen für Ihre Freundlichkeit. Mein schlechtes. Frohes neues Jahr!
    InformationsquelleAutor chris neilsen
  2. 1

    Versuchen, diese

    Sub CopyColumnToWorkbook()
Dim sourceColumn As Range, targetColumn As Range

Set sourceColumn = Workbooks("Source.xlsm").Worksheets(1).Columns("A:G" & lr)
Set targetColumn = Workbooks("Target.xlsm").Worksheets(1).Columns("A:G")

sourceColumn.Copy Destination:=targetColumn

Workbooks("Target.xlsm").Worksheets(1).Columns("C:D").EntireColumn.Delete
Workbooks("Target.xlsm").Worksheets(1).Columns("D:E").EntireColumn.Delete

End Sub
    • Vielen Dank für die Antwort. Tut mir Leid, ich habe so lange gebraucht, um Ihnen zu danken. Prost!
    InformationsquelleAutor Andrey Gordeev
Schreibe einen Kommentar