Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1112to1116
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

Kleiner Fehler im VBA-Code

Kleiner Fehler im VBA-Code
Mike
Hey, :-)
habe mit super Unterstützung von hier aus dem Forum den folgenden Code erstellt, der wunderbar funktioniert. ;-)
Zweck dabei ist es, die Inhalte verschiedener, identisch aufgebauter Tabellen im gleichen Ordner auszulesen und eine andere Datei zu übernehmen.
Nun brauche ich für eine andere Datei genau die gleiche Funktion, jedoch stehen die Daten dort nicht wie hier jeweils auf Blatt 1 der Ausgangstabellen, sondern auf Blatt 2... :-(
Kann mir jemand sagen, was ich dazu im Code ändern muss (alles andere bleibt gleich) - ich finde einfach keine Stelle im Code, die sich darauf bezieht...
VG u. vielen Dank Euch für jeden Tipp,
Mike
Sheets(1).Select
Range("R9:S39").Select
Selection.ClearContents
Range("A2:A3").Select
Sheets(3).Visible = True
Sheets(3).Select
Range("A9:S39").Select
Selection.ClearContents
Range("A2:A3").Select
Sheets(4).Visible = True
Sheets(4).Select
Range("A9:S39").Select
Selection.ClearContents
Range("A2:A3").Select
Sheets(5).Visible = True
Sheets(5).Select
Range("A9:S39").Select
Selection.ClearContents
Range("A2:A3").Select
Sheets(6).Visible = True
Sheets(6).Select
Range("A9:S39").Select
Selection.ClearContents
Range("A2:A3").Select
Sheets(7).Visible = True
Sheets(7).Select
Range("A9:S39").Select
Selection.ClearContents
Range("A2:A3").Select
Sheets(8).Visible = True
Sheets(8).Select
Range("A9:S39").Select
Selection.ClearContents
Range("A2:A3").Select
Sheets(9).Visible = True
Sheets(9).Select
Range("A9:S39").Select
Selection.ClearContents
Range("A2:A3").Select
Sheets(10).Visible = True
Sheets(10).Select
Range("A9:S39").Select
Selection.ClearContents
Range("A2:A3").Select
Sheets(1).Select
Range("A2:A3").Select
Dim I As Integer, J As Integer
Dim Datei As String, Pfad As String
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Pfad = ThisWorkbook.Path
Datei = Dir(Pfad & "\*.xls")
I = 9
Do While Datei ""
If Datei = ThisWorkbook.Name Then GoTo Weiter
Workbooks.Open Pfad & "\" & Datei
'##################### Daten kopieren #################
With ThisWorkbook.Sheets(3)
.Cells(I, 1).Value = Datei
For J = 1 To 18
.Cells(I, J + 1).Value = ActiveWorkbook.Sheets(1).Application.WorksheetFunction.Sum(Range(Cells(9, J + 1), Cells(10, J + 1)).Value)
Next J
End With
With ThisWorkbook.Sheets(4)
.Cells(I, 1).Value = Datei
For J = 1 To 18
.Cells(I, J + 1).Value = ActiveWorkbook.Sheets(1).Application.WorksheetFunction.Sum(Range(Cells(13, J + 1), Cells(15, J + 1)).Value)
Next J
End With
With ThisWorkbook.Sheets(5)
.Cells(I, 1).Value = Datei
For J = 1 To 18
.Cells(I, J + 1).Value = ActiveWorkbook.Sheets(1).Application.WorksheetFunction.Sum(Range(Cells(18, J + 1), Cells(21, J + 1)).Value)
Next J
End With
With ThisWorkbook.Sheets(6)
.Cells(I, 1).Value = Datei
For J = 1 To 18
.Cells(I, J + 1).Value = ActiveWorkbook.Sheets(1).Cells(24, J + 1).Value
Next J
End With
With ThisWorkbook.Sheets(7)
.Cells(I, 1).Value = Datei
For J = 1 To 18
.Cells(I, J + 1).Value = ActiveWorkbook.Sheets(1).Application.WorksheetFunction.Sum(Range(Cells(27, J + 1), Cells(32, J + 1)).Value)
Next J
End With
With ThisWorkbook.Sheets(8)
.Cells(I, 1).Value = Datei
For J = 1 To 18
.Cells(I, J + 1).Value = ActiveWorkbook.Sheets(1).Cells(35, J + 1).Value
Next J
End With
With ThisWorkbook.Sheets(9)
.Cells(I, 1).Value = Datei
For J = 1 To 3
.Cells(I, J + 1).Value = ActiveWorkbook.Sheets(1).Application.WorksheetFunction.Sum(Range(Cells(38, J + 1), Cells(67, J + 1)).Value)
Next J
End With
With ThisWorkbook.Sheets(10)
.Cells(I, 1).Value = Datei
For J = 1 To 3
.Cells(I, J + 1).Value = ActiveWorkbook.Sheets(1).Application.WorksheetFunction.Sum(Range(Cells(70, J + 1), Cells(90, J + 1)).Value)
Next J
End With
'##################### Ende Daten kopieren #################
ActiveWorkbook.Close False
I = I + 1
Weiter:
Datei = Dir()
Loop
Sheets(3).Visible = False
Sheets(4).Visible = False
Sheets(5).Visible = False
Sheets(6).Visible = False
Sheets(7).Visible = False
Sheets(8).Visible = False
Sheets(9).Visible = False
Sheets(10).Visible = False
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

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

Betreff
Benutzer
Anzeige
AW: Kleiner Fehler im VBA-Code
09.11.2009 14:43:46
robert
hi,
mE kann der code nicht von hier sein, wegen der vielen Select's...
und Blatt1 ist doch in Sheets(1) bezeichnet,
probier ActiveWorkbook.Sheets(1) auf activeWorkbook.Sheets(2) zu ändern
gruß
robert
AW: Kleiner Fehler im VBA-Code
09.11.2009 14:55:04
Mike
Hi Robert,
vielen Dank für die schnelle Antwort - werde ich gleich probieren ! :-)
Ich weiss, dass einige Stellen des Codes nicht sehr professionell aussehen, das sind wahrscheinlich auch i.d.R. die, die ich selber ergänzt habe - leider fehlt mir hier einfach (noch) das Wissen, um es auch in wenigen Befehlen zusammenfassen zu können... :-(
VG u. später,
Mike
Anzeige
Sheets(1).Range("A23:A28", "C25:C34").ClearContent
09.11.2009 15:04:43
robert
hi,
ein beispiel,
so geht es ohne Select
gruß
robert
..am ende fehlt ein s-Contents..owT
09.11.2009 15:06:25
robert

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige