VBA: Werte "flexibel" aus Mappe 1 nach Mappe 2 kopiren ...

amn.ssy

Erfahrenes Mitglied
... ohne Mappe 1 zu öffnen

Hallo,

bei nachfolgendem Code hänge ich schon den ganzen Tag fest.
Der Code stammt nicht komplett von mir (so gut bin ich nicht :-( ).
Da er aber stark in die Richtung geht in die ich will/muß möchte ich Ihn nun anpassen.

Ausgangspunkt:
Aus mehreren Mappen müssen Werte in einer Mappe zusammen gefasst werden.
Diese Werte stehen zwar immer in der gleichen Spalte, sind aber, auch von Monat zu Monat, unterschiedlich viele.
Ich möchte:
a) via Makro aus "Sammelmappe" heraus die entsprechnde Wertemappe auswählen
b) die Werte in der definierten Spalte bis zum jeweiligen Ende auslesen und
c) in der Sammelmappe ab der Stelle reinkopieren wo sich gerade der "Cursor" (ActiveCell?) befindet

usw. bis alle Werte aus den einzelnen Mappen eingesammelt sind.

der Code (funktioniert z.T) sieht bis jetzt so aus:
PHP:
Option Explicit

Public Function GetDataClosedWB(SourceFile As String, sourceSheet As String, _
        SourceRange As String, TargetRange As Range) As Boolean
        
    Dim strSource       As String
    Dim Rows            As Long
    Dim Columns         As Byte
    
    On Error GoTo InvalidInput
    
    strSource = "'" & SourceFile & sourceSheet & "'!" & Range(SourceRange).Cells(1, 1).Address(0, 0)
    Rows = Range(SourceRange).Rows.Count
    Columns = Range(SourceRange).Columns.Count
    
        With TargetRange.Cells(1, 1).Resize(Rows, Columns)
            .Formula = "=IF(" & strSource & "="""",""""," & strSource & ")"
            .Value = .Value
        End With
    
    GetDataClosedWB = True
    Exit Function
    
InvalidInput:
    MsgBox "The source file or source range is invalid!", vbExclamation
    GetDataClosedWB = False
End Function

Public Sub GetData()

    Dim sFile       As String
    Dim sSheet      As String
    Dim sRange      As String
    Dim rTarget     As Range

    sFile = Application.GetOpenFilename()
    sSheet = "Tabelle1"
    sRange = "D4:D22"
    
    Set rTarget = ActiveSheet.Range("C2")
        
        If GetDataClosedWB(sFile, sSheet, sRange, rTarget) Then
        MsgBox "Data imported"
        End If
End Sub

Das erste seltsame Verhalten (auch wenn's grundsatzlich funktioniert) taucht bei der Dateiauswahl auf:
Offensichtlich wird sFile nicht sauber an die Funktion übergeben bzw. nicht sauber verarbeitet, da ich die Datei 2 mal auswählen muß und anschließend noch mal die betreffende Tabelle.
Lt. Debugging bleib ich bei ".Formula = "=IF(" & strSource & "="""",""""," & strSource & ")" erstmal hängen.
Zuvor, als alles soweit tadellos funktionierte, hatte ich kein "GetOpenFilename()" drin sondern sDir und SFile fest verdrahted.
Wenn das schon mal sauber funktionieren würde wäre ich schon recht zufrieden.

Die anderen beiden Punkte betreffen sRange und rTarget:
sRange müßte ungef. so fünktionieren: sRange = "D4:bis letzter Wert in Spalte D"
rTarget stell ich mir etwa so vor: get rTarget = ActiveCell.Select ' die Zelle die aktuell markiert ist.

Ich freue mich über euren Rat, Tipps, wf. Links und womit Ihr sonst noch helfen könnt und mögt.

Grüße
_opiwahn_

update 24.01.
Teil c ist erledigt: "Set rTarget = ActiveCell" ... so einfach ist das ... :)
 
Zuletzt bearbeitet:
Zurück