title image


Smiley Re: So halt!
Oh, oh, my fault... Aus dem Dateinamen muss ja noch der Arbeitsmappenname extrahiert werden:



Option Explicit



Sub blkj()

Dim Originaldatei As String

Dim Originaltabelle As String

Dim Originalarbeitsmappe As String

Dim Zielarbeitsmappe As String

Dim Zieldatei As String

Dim Zieltabelle As String

Dim LetzteZeile As Long

Dim i As Long



Originaldatei = "d:\irgendwas\deinedatei.xls"

Originaltabelle = "Irgendwas"



Originalarbeitsmappe = Right(Originaldatei, Len(Originaldatei) - InStrRev(Originaldatei, "\"))





Zieldatei = "d:\irgendwas\irgendwasanderes.xls"

Zieltabelle = "Irgendeine Auswertung"



Zielarbeitsmappe = Right(Zieldatei, Len(Zieldatei) - InStrRev(Zieldatei, "\"))



Application.Workbooks.Add

ActiveWorkbook.SaveAs Zieldatei

Workbooks(Zielarbeitsmappe).Activate

Sheets("Tabelle1").Name = Zieltabelle



LetzteZeile = Workbooks(Originalarbeitsmappe).Sheets(Originaltabelle).Cells.SpecialCells(xlLastCell).Row



For i = 1 To LetzteZeile

Workbooks(Zielarbeitsmappe).Sheets(Zieltabelle).Cells(i, 1).Value = Workbooks(Originalarbeitsmappe).Sheets(Originaltabelle).Cells(i, 1).Value

Workbooks(Zielarbeitsmappe).Sheets(Zieltabelle).Cells(i, 2).Value = Workbooks(Originalarbeitsmappe).Sheets(Originaltabelle).Cells(i, 3).Value

Workbooks(Zielarbeitsmappe).Sheets(Zieltabelle).Cells(i, 3).Value = Workbooks(Originalarbeitsmappe).Sheets(Originaltabelle).Cells(i, 8).Value

Workbooks(Zielarbeitsmappe).Sheets(Zieltabelle).Cells(i, 4).Value = Workbooks(Originalarbeitsmappe).Sheets(Originaltabelle).Cells(i, 9).Value

Workbooks(Zielarbeitsmappe).Sheets(Zieltabelle).Cells(i, 5).Value = Workbooks(Originalarbeitsmappe).Sheets(Originaltabelle).Cells(i, 10).Value

Next i



Workbooks(Zielarbeitsmappe).Save



End Sub

Gruß aus Ostfriesland. Möge Tux mit Dir sein!

ff


Proggst du schon .net oder quälst du dich noch mit VB6?



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: