Office: Spalte einfügen und mit Wert füllen

Moin zusammen,

ich brauch mal eure Hilfe, denn ich hab nen wichtigen Makro verlegt, den ich für ne große Datenauswertung brauche *frown.gif* *frown.gif* *frown.gif*

Der Makro machte für alle Dateien in einem Verzeichnis folgendes:

• Datei öffnen

• Neue Spalte vor Spalte A einfügen

• Das Datum (genauer: die ersten 10 Zeichen) aus Zelle B3 von oben nach unten (genauer: vom neuen A1 bis zur letzten belegten Zeile) in der neuen Spalte einfügen

• Datei speichern und schließen

Ein Beispiel mit Vorher- / Hinterher-Aussehen habe ich beigefügt.

Kann mir vielleicht jemand mit so einem Makro aushelfen ?

Ich schäme mich auch ganz doll und passe beim nächsten Mal besser auf *Smilie

Besten Dank für Eure Hilfe.

:)

 

Moin ,

PHP:

         Sub Makro1()

Columns("A:A").Insert Shift:=xlToRight

Range("A1").FormulaR1C1 = "=LEFT(R[2]C[2],10)"

Range("A1").Value = Range("A1").Value

Range("A1:A" & Cells(Rows.Count, 2).End(xlUp).Row).FormulaR1C1 = Range("A1").FormulaR1C1

Range("A:A").Font.Color = vbRed


End Sub


 

Danke Solitec.

Der Makro macht schon fast was ich brauche.

Leider hab ich 365 Dateien und müsste ihn überall einbauen, starten und die Dateien dann speichern *frown.gif*

Könnte man den so ergänzen, daß
* ich ihn in eine Master-Datei im Verzeichnis reintue und von dort aus starte,
* er nacheinander alle Dateien in diesem Verzeichnis aufruft und bearbeitet (falls er sich selber bearbeitet ist das nicht schlimm) und
* alle Dateien dann wieder speichert und schließt ?

Ganz großen Dank für die Mühe.

 

Ich gucke mir das später nochmal an

 

Hi ,

warum muss das Datum in den Zeilen 1 bis 5 stehen ?

Hier mein Vorschlag:

PHP:

         Dim Pfad As String
Dim Datei As String
Dim letzteZeile As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim zeile As Long

Sub Öffnen()


Set ws = ThisWorkbook.Worksheets(1)
letzteZeile = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For zeile = 2 To letzteZeile
Pfad = ws.Cells(zeile, "A")   'In Spalte A den Pfad eintragen
Datei = ws.Cells(zeile, "B")  'In Spalte B den Dateinamen eintragen (Test.xls)
If Right(Pfad, 1) <> "" Then Pfad = Pfad & ""
If Dir(Pfad & Datei) <> "" Then
Set wb = Workbooks.Open(Pfad & Datei)
Set ws1 = wb.Worksheets(1)

Columns("A:A").Insert Shift:=xlToRight
Range("A1").FormulaR1C1 = "=LEFT(R[2]C[2],10)"
Range("A1").Value = Range("A1").Value
Range("A1:A" & Cells(Rows.Count, 2).End(xlUp).Row).FormulaR1C1 = Range("A1").FormulaR1C1
Range("A:A").Font.Color = vbRed

wb.Save
wb.Close
End If
Next zeile
End Sub


 

Sorry für die Verzögerung -- ich war auf der Suche nach dem Fehler.

Ich bekomme meistens "Laufzeitfehler 1004 ..." und manchmal "Wir konnten "" nicht finden..." (vgl. beigefügte Datei, Sheet Fehlermeldungen).

Mach ich mit dem Dateipfad was falsch ? Dateiname ? Sheet-Name ? Einzüge verrissen ?

Die Fehlerart scheint mir auch wechselnd zu sein, je nachdem ob ich die Datei neu anlege und dann Code einfüge oder mit einer bestehenden Datei weiterprobiere.

Das Verschiebemodul funktioniert, wenn ich es allein teste. Ich hab versucht den Fehler zu isolieren und er muß irgendwo im fetten Bereich stecken:

Dim Pfad As String
Dim Datei As String
Dim letzteZeile As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim zeile As Long

Sub Öffnen()

Set ws = ThisWorkbook.Worksheets(1)
letzteZeile = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For zeile = 2 To letzteZeile
Pfad = ws.Cells(zeile, "A") 'In Spalte A den Pfad eintragen
Datei = ws.Cells(zeile, "B") 'In Spalte B den Dateinamen eintragen (Test.xls)
If Right(Pfad, 1) "" Then Pfad = Pfad & ""
If Dir(Pfad & Datei) "" Then
Set wb = Workbooks.Open(Pfad & Datei)
Set ws1 = wb.Worksheets(1)

Columns("A:A").Insert Shift:=xlToRight
Range("A1").FormulaR1C1 = "=LEFT(R[2]C[2],10)"
Range("A1").Value = Range("A1").Value
Range("A1:A" & Cells(Rows.Count, 2).End(xlUp).Row).FormulaR1C1 = Range("A1").FormulaR1C1
Range("A:A").Font.Color = vbRed

wb.Save
wb.Close
End If
Next zeile
End Sub

***********
Das Datum kann ganz oben oder erst bei den Daten anfangen -- ist egal.

 

Hallo ,

ändre die Zeile :

in

die Zeile 1 wurde ausgelassen.
Datei im Anhang.
Mit der Datei habe ich es an drei anderen Dateien ausprobiert.
Funktioniert....
Guck das in der Tabelle wo du den Pfad und Dateinamen stehen hasst nichts anderes in den Spalte steht.

 

Danke, *Smilie *Smilie *Smilie

jetzt klappt alles makellos.

Ich wußte nicht, daß ich alle 365 Dateinamen explizit vorgeben muß.

Zum Glück sind die fortaufend, sodaß ich die Namen automatisch erstellen lassen kann. Sonst hätte noch ne alte Batch-Datei von 1996, die das für mich auflisten könnte.

Jetzt mach ich mir erstmal ganz viele Sicherungskopien. *biggrin.gif*