ich habe folgendes Makro hier im Archiv gefunden:
--------------------------------------------------------------
Sub Multiopen()
Dim arrFilenames As Variant
Dim wkbArr As Workbook
Dim wkbBasis As Workbook
Set wkbBasis = ActiveWorkbook
Selection:
' Zu öffnende Dateien erfragen
arrFilenames = Application.GetOpenFilename( _
"Exceldateien (*.xls), *.xls, Alle Dateien (*.*), *.*", 1, _
"Exceldateien auswählen...", MultiSelect:=True) ' Ausgewählte Dateien des Öffnen-Dialoges in Feld ablegen
If VarType(arrFilenames) = vbBoolean Then
If MsgBox("Sie haben keine Dateien ausgewählt. Möchten sie das Makro beenden?", vbYesNo, "Frage") = vbNo Then
GoTo Selection
Else
Set wbkBasis = Nothing
Exit Sub
End If
End If
Application.ScreenUpdating = False
'Die vom Makro vorgenommenen Tätigkeiten
'bleiben zur Geschwidigkeitssteigerung unsichtbar
For i = 1 To UBound(arrFilenames) ' Durchläuft die Anzahl der Dateien
'Wenn Datei noch nicht geöffnet
If FileOpenYet(DIR$(arrFilenames(i))) = False Then
'dann öffnen
Workbooks.Open FileName:=arrFilenames(i)
Else
'oder aktivieren
Workbooks(DIR$(arrFilenames(i))).Activate
End If
Set wkbArr = ActiveWorkbook
'-------------------------------------------------------
'hier kommt dann der Code rein, der die ausgewählten Dateien
'betrifft. Die Ursprungsdatei ist über wbkBasis ansprechbar.
wkbBasis.Worksheets(1).Cells(i, 1).value = wkbArr.Worksheets(1).Range("B1").value
wkbBasis.Worksheets(1).Cells(i, 2).value = wkbArr.Worksheets(2).Range("C34").value
wkbBasis.Worksheets(1).Cells(i, 3).value = wkbArr.Worksheets(3).Range("S32").value
wkbArr.Close SaveChanges:=False 'Datei schließen
Set wkbArr = Nothing
'-------------------------------------------------------
Next i
Set wkbArr = Nothing
'Ursprüngliche Datei wieder aktivieren
wkbBasis.Activate
Set wkbBasis = Nothing 'Die Variable zurücksetzen
'und den Monitor aktivieren
Application.ScreenUpdating = True
End Sub
Function FileOpenYet(FileName As String) As Boolean
'eine Funktion, die Prüft ob eine Datei schon geöffnet ist.
Dim s As String
On Error GoTo Nonexistent
s = Workbooks(FileName).name
FileOpenYet = True
Exit Function
Nonexistent:
FileOpenYet = False
End Function
--------------------------------------------------------------------------------
Dieses öffnet ein bestehendes Excel File und kopiert die Inhalte bestimmter Zellen in, wiederum fest bestimmbare, Zellen des aktuellen Worksheets.
Die Problemstellung, die ich lösen möchte ist ganz ähnlich wie die im obigen Makro durchgeführte Lösung.
Allerdings möchte jeweils nebeneinanderliegende Spalten von einem bestehenden File das aktuelle worksheet kopieren. Hierbei möchte ich gern auswählen können, welche Spalten ich kopieren möchte. Also in der Art: "Welche Spalten möchten Sie kopieren?" -> C und D ....
Leider bin ich absoluter Anfänger im Bereich von VBS und wäre echt dankbar, wenn Ihr Euch meines Problemchens annehmen könntet!
Danke Jo