in neue Arbeitsmappe kopieren

Hallo,
ich habe ein Problem für das ich keine Lösung finde, weil ich nicht recht weiß wie ich's bei der suche formulieren soll.
und zwar....
ich habe eine Tabelle mit 13 Spalten. Darin stehen pro Zeile ein Artikel der bestellt werden muss. Da stehen so sachen wie Bestelnummer,Menge,Wer es bestellt und bei welcher Firma bestellt wird.
Jetzt muss ich sämtliche Daten in einer anderen Reihenfolge und auch nicht alle Spalten in ein bestmmtes Formular(Excel) einkaufsabteilung schreiben. Um mir die Arbeit zu erleichtern würde ich dies gerne automatisch machen da ich ja schon alles in Excel habe.
Nun muss ich für jede Firma ein separates formular ausfüllen.
Ich dacht mir das das Makro nach der Firma sucht, ein neues Formular öffnet und alle Artikel dieser Firma da hinein schreibt. Und das solange bis alle Firmen ein eigenes Formular haben.
Dann brauch ich die nur noch per Mail verschicken.
Wäre toll wenn es da eine Lösung gäbe.
Vielen Dank schon mal
Keiler

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Du hast Extra keine Datei verlinkt, da Du die Lösung selber an Deine Bedingungen anpassen wolltest. Ich habe diese Lösung erstellt und bin dann raus. Viel Erfolg.

Option Explicit
Sub Uebvertragen()
Dim LoLetzte As Long
Dim LoletzteD As Long
Dim LoI As Long
Dim BoOffen As Boolean
Dim WsTabelle As Worksheet
Dim WbDatei As Workbook
Application.ScreenUpdating = False
Set WsTabelle = ActiveSheet
LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 3)), Cells(Rows.Count, 3).End(xlUp).Row, Rows. _
Count)
For LoI = 2 To LoLetzte
BoOffen = False
For Each WbDatei In Workbooks
If WbDatei.Name = WsTabelle.Cells(LoI, 3) & ".xlsx" Then
BoOffen = True
Exit For
End If
Next WbDatei
If BoOffen = False Then
Workbooks.Add
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & WsTabelle.Cells(LoI, 3) &  _
".xlsx", FileFormat:= _
xlOpenXMLWorkbook
Application.DisplayAlerts = True
WsTabelle.Cells(1, 1).Copy Cells(1, 3)
WsTabelle.Cells(1, 2).Copy Cells(1, 23)
WsTabelle.Cells(1, 7).Copy Cells(1, 4)
End If
With Workbooks(WsTabelle.Cells(LoI, 3) & ".xlsx").Worksheets(1)
LoletzteD = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
WsTabelle.Cells(LoI, 1).Copy .Cells(LoletzteD, 3)
WsTabelle.Cells(LoI, 2).Copy .Cells(LoletzteD, 23)
WsTabelle.Cells(LoI, 7).Copy .Cells(LoletzteD, 4)
End With
Next LoI
Set WsTabelle = Nothing
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

in neue Arbeitsmappe kopieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread