Hallo Tino oder andere Helfer
06.01.2014 22:08:53
Albert
diesen Beitrag habe ich vor ca 1 1/2 Wochen gepostet, jedoch keine Lösung gefunden.
Vielleicht ist Tino auch noch auf Urlaub, ich würde jedoch in den nächsten Tagen dringend eine Lösung benötigen.
Den nachstehenden VBA-Code hat mir Tino vor Monaten zur Verfügung gestellt:
Sub Werte_importieren2()
Dim Pfad_lokal As String
Dim wbZiel As Workbook, wsZiel As Worksheet
Dim wbQuelle As Workbook, wsQuelle As Worksheet, rngQuelle As Range
Dim nRQ&, nRZ&
Set wsZiel = Tabelle1
Pfad_lokal = wsZiel.Range("J10").Value
If Dir(Pfad_lokal, vbNormal) = "" Then
MsgBox "Datei" & vbCr & Pfad_lokal & vbCr & "nicht gefunden", vbExclamation
Exit Sub
End If
Set wbQuelle = Workbooks.Open(Pfad_lokal)
On Error Resume Next
Set wsQuelle = wbQuelle.Worksheets("Journal")
If wsQuelle Is Nothing Then
MsgBox "Tabelle 'Journal' in der Datei " & vbCr & Pfad_lokal & vbCr & "nicht gefunden", _
vbExclamation
Exit Sub
End If
On Error GoTo 0
On Error GoTo ErrorHandler:
With Application
.ScreenUpdating = False
.EnableEvents = False
If Not wsQuelle Is Nothing Then
With wsQuelle
nRZ = 4 'Voreinstellung
For nRQ = 12 To 28 Step 8
nRZ = nRZ + 8 'von letzter +8 Zeilen
For Each rngQuelle In Union(.Cells(nRQ, 3), .Cells(nRQ, 9), .Cells(nRQ, 10)). _
Areas
'nur Werte
With wsZiel.Cells(nRZ, rngQuelle.Column).Resize(, rngQuelle.Columns.Count)
.Value = rngQuelle.Value
.Copy
.PasteSpecial Paste:=xlPasteFormats
End With
Next rngQuelle
Next nRQ
End With
End If
ErrorHandler:
On Error Resume Next
wbQuelle.Close SaveChanges:=False
ThisWorkbook.Activate
Application.Goto Tabelle1.Cells(15, 3)
.ScreenUpdating = True
.EnableEvents = True
End With
If Err.Number 0 Then
MsgBox Err.Description, _
vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub
Ich habe den Code teilweise für die geänderten Erfordernisse angepasst und habe nun zwei Fragen, die ich mit meinen bescheidenen VBA-Kenntnissen nicht lösen konnte.
1) Wie ist der Code abzuändern, damit aus Spalte J ( .Cells(nRQ, 10)) auch die Formeln (und nicht nur Werte) kopiert werden. (Zelle kopieren (Formeln u. Formate) wäre für meine Zwecke das Beste)
Falls diese Variante zu kompliziert wird, wäre für meine Zwecke auch (copy and paste) des Bereichs A:J (jede achte Zeile....) zielführend.
2) Ich muss auch Werte aus einer zweiten Tabelle (von derselben Quellarbeitsmappe) importieren und habe nun den Code angepasst und definiere die Quellarbeitsmappe wieder mit:
Set wbQuelle = Workbooks.Open(Pfad_lokal) - Import funktioniert, ich möchte nur die Warnmeldung vermeiden, dass Quelldatei bereits geöffnet ist.
Application.DisplayAlerts = False führt nicht zum gewünschten Ergebnis. Gibt es eine andere Möglichkeit die (bereits geöffnete) Quellarbeitsmappe zu definieren und somit diese Warnmeldung zu vermeiden?
Ich bedanke mich nochmals für Deine (Eure) tolle Unterstützung und hoffe, dass ich mit meinen neuerlichen Fragen nicht lästig erscheine.
LG Albert