Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1344to1348
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro liefert nur teilweise gewünschtes Ergebnis

Makro liefert nur teilweise gewünschtes Ergebnis
26.01.2014 12:47:05
Albert
Hallo VBA Experten,
ich habe das Problem mit nachstehendem Makro, dass aus für mich unerklärlichen Gründen manchmal die gewünschten Formeln kopiert, manchmal jedoch nur die in den Zellen enthaltenen Werte. Ich hoffe, es kann mir da jemand unter die Arme greifen.
Sub Import()
Dim Pfad_lokal As String
Dim wbZiel As Workbook, wsZiel As Worksheet
Dim wbQuelle As Workbook, wsQuelle As Worksheet, rngQuelle As Range, rngQuelle2 As Range,  _
rngQuelle3 As Range, rngQuelle4 As Range
Dim nRQ&, nRQ2&, nRQ3&, nRQ4&, nRZ&, nRZ2&, nRZ3&, nRZ4&, lngSpalte As Long, lngSpalte2 As Long, _
lngSpalte3 As Long, lngSpalte4 As Long
Set wsZiel = Tabelle1
Pfad_lokal = wsZiel.Range("AE5").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
.DisplayAlerts = False
Dim j%
j = MsgBox("Angabe für Dateien ab Herbst 2013 importieren?", vbYesNo)
If j = 7 Then GoTo S:
If Not wsQuelle Is Nothing Then
.ScreenUpdating = False
With wsQuelle
nRZ = 4
For nRQ = 12 To 244 Step 8
nRZ = nRZ + 8
For lngSpalte = 1 To 10
Select Case lngSpalte
Case 1, 9
Set rngQuelle = .Cells(nRQ, lngSpalte)
wsZiel.Cells(nRZ, rngQuelle.Column).Value = rngQuelle.Value
Case 3, 10
Set rngQuelle = .Cells(nRQ, lngSpalte)
rngQuelle.Copy
With wsZiel.Cells(nRZ, rngQuelle.Column)
.PasteSpecial Paste:=xlFormats
.PasteSpecial Paste:=xlFormulas
End With
End Select
Next lngSpalte
Next nRQ
End With
End If         'Dieser Abschnitt liefert die gewünschten Ergebnisse
S:
Dim m%
m = MsgBox("Lösungswerte importieren?", vbYesNo)
If m = 7 Then GoTo T:
If Not wsQuelle Is Nothing Then
.ScreenUpdating = False
With wsQuelle
nRZ3 = 7
For nRQ3 = 15 To 247 Step 8
nRZ3 = nRZ3 + 8
For lngSpalte3 = 15 To 22
Select Case lngSpalte3
Case 15, 21
Set rngQuelle3 = .Cells(nRQ3, lngSpalte3)
wsZiel.Cells(nRZ3, rngQuelle3.Column).Value = rngQuelle3.Value
Case 19, 20, 22
Set rngQuelle3 = .Cells(nRQ3, lngSpalte3)
rngQuelle3.Copy
With wsZiel.Cells(nRZ3, rngQuelle3.Column)
.PasteSpecial Paste:=xlFormats
.PasteSpecial Paste:=xlFormulas
End With
End Select
Next lngSpalte3
Next nRQ3
End With
End If        'Dieser Abschnitt liefert für die Spalten 19, 20, 22 nur Werte anstatt der  _
Formeln
If Not wsQuelle Is Nothing Then
.ScreenUpdating = False
With wsQuelle
nRZ2 = 8
For nRQ2 = 16 To 248 Step 8
nRZ2 = nRZ2 + 8
For lngSpalte2 = 15 To 23
Select Case lngSpalte2
Case 15
Set rngQuelle2 = .Cells(nRQ2, lngSpalte2)
wsZiel.Cells(nRZ2, rngQuelle2.Column).Value = rngQuelle2.Value
Case 19, 20, 21, 22, 23
Set rngQuelle2 = .Cells(nRQ2, lngSpalte2)
rngQuelle2.Copy
With wsZiel.Cells(nRZ2, rngQuelle2.Column)
.PasteSpecial Paste:=xlFormats
.PasteSpecial Paste:=xlFormulas
End With
End Select
Next lngSpalte2
Next nRQ2
End With
End If         'Dieser Abschnitt liefert für Spalte 19 Werte (sollte Formel liefern), für  _
20, und 21 Formel, für 22 wieder Werte anstatt Formel, für 23 wieder Formel
T:
Dim n%
n = MsgBox("Hilfszeile importieren?", vbYesNo)
If n = 7 Then GoTo U:
.ScreenUpdating = False
If Not wsQuelle Is Nothing Then
.ScreenUpdating = False
With wsQuelle
nRZ4 = 4
For nRQ4 = 12 To 244 Step 8
nRZ4 = nRZ4 + 8
For lngSpalte4 = 14 To 23
Select Case lngSpalte4
Case 14, 15, 16, 17, 20, 23
Set rngQuelle4 = .Cells(nRQ4, lngSpalte4)
wsZiel.Cells(nRZ4, rngQuelle4.Column).Value = rngQuelle4.Value
Case 21, 22, 18, 19
Set rngQuelle4 = .Cells(nRQ4, lngSpalte4)
rngQuelle4.Copy
With wsZiel.Cells(nRZ4, rngQuelle4.Column)
.PasteSpecial Paste:=xlFormats
.PasteSpecial Paste:=xlFormulas
End With
End Select
Next lngSpalte4
Next nRQ4
End With
End If          'Dieser Abschnitt liefert für Spalte 18 und 19 Werte (anstatt Formeln), für  _
21 und 22 die gewünschten Formeln
U:
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
ErrorHandler:
On Error Resume Next
ThisWorkbook.Activate
Application.Goto Tabelle1.Cells(15, 3)
If Err.Number  0 Then
MsgBox Err.Description, _
vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
Range("B12").Select
Application.ScreenUpdating = True
MsgBox ("Datum in markierter Zelle (=B12) mit aktueller Jahreszahl versehen!")
End Sub
Bereits im Voraus herzlichen Dank für die Unterstützung
Albert

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Doppelt
26.01.2014 12:48:47
Hajo_Zi
warum neuen Beitrag der alte ist doch noch offen?
Gruß Hajo

AW: Doppelt
26.01.2014 13:12:40
Albert
Hallo Hajo,
wenn Du den Beitrag von Stefan liest, dann wird hoffentlich klar warum "Doppelt".
Ich dachte mir, es ist übersichtlicher den ungeklärten Bereich noch einmal zu posten.
Gruß
Albert

...denk nicht,halt dich an die Regeln..
26.01.2014 13:17:14
robert

AW: ...denk nicht,halt dich an die Regeln..
26.01.2014 16:42:46
Albert
Danke für die nette Rückmeldung, wird sicher nicht mehr vorkommen.
Albert
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige