ich hatte bisher ein VBA Makro, welches ein paar Zellinhalte in ein neues Tabellenblatt aus einem Dateien-Ordner ausgelesen hat. Nun wurden die Erfassungs-Blätter geändert und das alte Makro passt leider nicht mehr.
Hier mein altes Makro:
Sub Konsolidierung()
'Variablen Definitionen
Dim MySheet As Worksheet ' aktuelles Arbeitsblatt der offenen Ziel-Datei-hier werden die Daten _
reingeschrieben
Dim strPath As String ' Dateipfad zum Auslesen der Dateien
Dim strFile As String ' Quelldatei
Dim wkbInput, meins As Workbook ' Quell-Arbeitsmappe
Dim wksInput As Worksheet ' Quell-Registerblatt
Dim lngTargetRow As Long ' Zeilenzähler für die Bewertungsinformationen
Dim lRow As Long ' Schleifenzähler
Dim lCol As Long ' Schleifenzähler
Dim delta As Integer
Application.DisplayAlerts = False
delta = 0 'Zaehler um in die nächste Zeile zu schreiben
'Merkt sich die Daten der Zieldatei
Set MySheet = ActiveSheet
Set meins = ActiveWorkbook
strPath = ActiveWorkbook.Path
' Verzeichnis durchgehen und alle Dateien auslesen
strFile = Dir(strPath & "\*.xls")
Do While strFile "" ' Schleife beginnen
If strFile = ActiveWorkbook.Name Then
' Zieldatei natürlich übergehen
Else
' Quelldatei öffnen
' und 1. Registerblatt auswählen
Set wkbInput = Application.Workbooks.Open(strPath & "\" & strFile)
Set wksInput = wkbInput.Worksheets("Tabelle1") 'Hier ist das Quell-Sheet zu definieren zwischen _
die Hochkommata die Bezsichnung des sheets eingeben
' Daten auslesen und in Auswertung kopieren
'Ab hier musst DU definieren, wleche Daten von wo nach wo geschrieben werden sollen. kannst Du _
mehrfach anwenden, wenn Du Daten aus mehreen Zellen auslesen willst
'Muss ich den nachfolgenden Code für jede auszulesende Zelle wiederholen? JA Und wenn ja bis zu _
welcher Stelle gehört dieser Bereich also welche Zeile? siehe unten
wksInput.Activate 'Auswahl Quell-Sheet
wksInput.Cells(1, 3).Select 'Select der Quell-Zelle gebe ich hier die Zelle ein als B4, D7 etc.? _
'wksInput.Cells(1, 3).Select
Selection.Copy 'Kopieren
meins.Activate 'Aktivieren des-Ziel-Workbook
MySheet.Activate 'Aktivieren des Ziel-Sheet
MySheet.Cells(2 + delta, 1).Select 'Auswahl Ziel-Zellen (zeilen werden durch Delta hochgezählt)
'Einfügen des Wertes
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wksInput.Activate 'Auswahl Quell-Sheet
'wksInput.Cells(1, 5).Select 'Select der Quell-Zelle gebe ich hier die Zelle ein als B4, D7 etc. _
wksInput.Cells(1, 5).Select
Selection.Copy 'Kopieren
meins.Activate 'Aktivieren des-Ziel-Workbook
MySheet.Activate 'Aktivieren des Ziel-Sheet
MySheet.Cells(2 + delta, 2).Select 'Auswahl Ziel-Zellen (zeilen werden durch Delta hochgezählt)
'Einfügen des Wertes
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wksInput.Activate 'Auswahl Quell-Sheet
'wksInput.Cells(1, 33).Select 'Select der Quell-Zelle gebe ich hier die Zelle ein als B4, D7 _
etc.?
wksInput.Cells(1, 33).Select
Selection.Copy 'Kopieren
meins.Activate 'Aktivieren des-Ziel-Workbook
MySheet.Activate 'Aktivieren des Ziel-Sheet
MySheet.Cells(2 + delta, 3).Select 'Auswahl Ziel-Zellen (zeilen werden durch Delta hochgezählt)
'Einfügen des Wertes
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wksInput.Activate 'Auswahl Quell-Sheet
'wksInput.Cells(1, 33).Select 'Select der Quell-Zelle gebe ich hier die Zelle ein als B4, D7 _
etc.?
wksInput.Cells(13, 3).Select
Selection.Copy 'Kopieren
meins.Activate 'Aktivieren des-Ziel-Workbook
MySheet.Activate 'Aktivieren des Ziel-Sheet
MySheet.Cells(2 + delta, 4).Select 'Auswahl Ziel-Zellen (zeilen werden durch Delta hochgezählt)
'Einfügen des Wertes
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wksInput.Activate 'Auswahl Quell-Sheet
'wksInput.Cells(1, 33).Select 'Select der Quell-Zelle gebe ich hier die Zelle ein als B4, D7 _
etc.?
wksInput.Cells(5, 3).Select
Selection.Copy 'Kopieren
meins.Activate 'Aktivieren des-Ziel-Workbook
MySheet.Activate 'Aktivieren des Ziel-Sheet
MySheet.Cells(2 + delta, 5).Select 'Auswahl Ziel-Zellen (zeilen werden durch Delta hochgezählt)
'Einfügen des Wertes
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wksInput.Activate 'Auswahl Quell-Sheet
'wksInput.Cells(1, 33).Select 'Select der Quell-Zelle gebe ich hier die Zelle ein als B4, D7 _
etc.?
wksInput.Cells(11, 3).Select
Selection.Copy 'Kopieren
meins.Activate 'Aktivieren des-Ziel-Workbook
MySheet.Activate 'Aktivieren des Ziel-Sheet
MySheet.Cells(2 + delta, 6).Select 'Auswahl Ziel-Zellen (zeilen werden durch Delta hochgezählt)
'Einfügen des Wertes
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
delta = delta + 1 'Nächste Zeile
' Bis hier CODE zum Auslesen
' Datei schließen
wkbInput.Close
Set wkbInput = Nothing
End If
strFile = Dir ' Nächsten Eintrag abrufen
Loop
MsgBox "Ich habe Fertig!"
End Sub
Hier ein Muster der Tabellenblätter welche sich dann in dem Dateien-Ordner zumd auszulesen befinden:
https://www.herber.de/bbs/user/119385.xlsm
Die ausgelesenen Daten aus den Zellen sollen in einem neuem eigenem Sheet in Listform wie folgt stehen (eine Zeile pro Tabellenblatt):
C1 = Bauvorhaben
F1= Kundennummer
D13= Deckung Summe
=$AI$1= %-Deckungssumme
Beim Versuch mein altes Makro über die neuen Tabellenblätter laufen zu lassen, ergab sich zusätzlich ein weiteres Problem:
die Erfassungs-Tabellenblätter haben nun selbst Makros, welche das flüssige Auslesen beim "schliessen" das Makro auch noch stoppen.
Nachdem ich das Makro schon damals gestrickt bekommen habe, da ich keine Kenntnis über VBA habe, hoffe mir kann diesbezüglich jemand bitte weiterhelfen.
Danke & Gruss,
Juergen