Extrahieren von Daten aus einem Blatt in excel mit VBA-Makro

Hier ist das Makro, ich habe nur geschrieben, leider ist es nicht scheinen, etwas zu tun und ich kann nicht finden den Fehler! Ich bin versucht zu kopieren, die Spalte mit der überschrift "Gegenkonto" von Blatt 1 (SAPDump) Blatt 2 (Auszug) die ist leer. Kann jemand sehen, erklären Sie mir, warum funktioniert das nicht? Ziemlich neu in VBA, so dass es wahrscheinlich eine einfache Lösung. Cheers

Sub ExtractData()

' Define sheets

Dim SAPDump As Worksheet
Dim Extract As Worksheet

' Set sheets

Set SAPDump = ActiveSheet
Set Extract = ThisWorkbook.Sheets("Extract")

' Define row and column counters

Dim r As Long
Dim c As Long

' Set last non-empty column

Dim lastCol As Long
lastCol = SAPDump.Cells(1, Columns.Count).End(xlToLeft).Column

' Set last non-empty row

Dim lastRow As Long
lastRow = SAPDump.Cells(Rows.Count, "A").End(xlUp).row

' Look a all columns
For c = 1 To c = lastCol
    ' Examine top column
    If SAPDump.Cells(1, c).Value = "Offset Acct" Then
        ' Loop round all rows
        For r = 1 To r = lastRow
            ' Copy column into A on Extract
            Extract.Cells(r, 1) = SAPDump.Cells(r, c)
        Next r
    Else

    End If

Next c

End Sub
  • Bitte verwenden Sie nicht die Makros tag für MS Office / VBA.
InformationsquelleAutor James Baker | 2015-07-16
  1. 2

    Müssen Sie, um diese Zeilen zu ändern:

    For c = 1 To c = lastCol

    to

For c = 1 To lastCol

    und

    For r = 1 To r = lastRow

to

For r = 1 To lastRow

    Edit:

    Einen besseren Weg, dies zu tun:

    Sub ExtractData()

    ' Define sheets
    Dim SAPDump As Worksheet
    Dim Extract As Worksheet

    'Define Heading range
    Dim rHeadings As Range
    Dim rCell As Range

    ' Set sheets
    Set SAPDump = ActiveSheet
    Set Extract = ThisWorkbook.Sheets("Extract")

    'Set Heading range.
    With SAPDump
        Set rHeadings = .Range(.Cells(1, 1), .Cells(1, Columns.Count).End(xlToLeft))
    End With

    'Look at each heading.
    For Each rCell In rHeadings
        If rCell.Value = "Offset Acct" Then
            'If found copy the entire column and exit the loop.
            rCell.EntireColumn.Copy Extract.Cells(1, 1)
            Exit For
        End If
    Next rCell

End Sub
    • Das ist toll danke!!! Jede Hilfe mit anderen verbessert würde geschätzt werden.
    • Ich war nur zu schreiben, die alternative, wenn Sie kommentiert. 🙂
    • Funktioniert Super danke!
    InformationsquelleAutor Darren Bartrup-Cook
  2. 0

    Den Satz nicht sicher, wie man das gleiche in excel-makro.

    Verlangen, dass Sie senden das gleiche über die .pdf-formate.

    Hinsichtlich

    Stalin.

    InformationsquelleAutor stalin
Schreibe einen Kommentar