title image


Smiley Re: Formelfreund sucht VBA-Hilfe
Hallo Andy,

muss leider weg und kann es nichttmehr testen, aber versuchs mal damit:



Sub Andy_D()



Dim Lieferanten As Worksheet, Daten As Worksheet

Dim Ziel As Worksheet

Dim c As Range

Dim Ende As Long

Dim I As Long, J As Long



Set Lieferanten = Worksheets("Lieferanten")

Set Daten = Worksheets("Daten")

Set Ziel = Worksheets("Ziel")

Daten.Select

Ziel.Cells.Delete

Ende = Daten.Cells(Rows.Count, 1).End(xlUp).Row

Daten.Columns("A:G").AutoFilter

J = 1

For Each c In Lieferanten.Range("A1:A4") 'an deine Belange anpassen

ActiveSheet.AutoFilter Field:=7, Criteria1:="1"

For I = 1 To Ende

If Daten.Rows(I).Height > 0 Then

Daten.Rows(I).Copy Destination:=Ziel.Range("A" & J)

J = J + 1

End If

Next I

With Ziel.PageSetup

.Zoom = False

.Orientation = xlLandscape

.FitToPagesWide = 1

End With

Ziel.Columns("A:J").AutoFit

Ziel.Copy

ActiveWorkbook.SaveAs "lieferant_Nr_" & c.Value

ActiveWorkbook.Close

Next c



End Sub


Gruß Worti <img src="http://media2.giga.de/2015/06/snapchat-smiley-sonnenbrille.png">



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: