Mehrere Zellen kopieren und Schleife einbauen

  • Excel

Es gibt 11 Antworten in diesem Thema. Der letzte Beitrag () ist von Werner45.

    Mehrere Zellen kopieren und Schleife einbauen

    Hallo zusammen!
    Ich hab mir nachfolgenden Code gebastelt um Kundendaten aus der Datei Kunden.xlsx in mein Rechnungsformular zu übertragen. Hat vielleicht jemand eine Idee wie die Daten schneller übertragen werden?
    Ich habe noch nie eine Schleife gebastelt, und wollt fragen ob mir jemand sagen kann wie ich eine Schleife (Do Loop Until) einbauen muss, so dass nach dem Auswählen des ersten Kunden der zweiten, dann der Dritte usw. ausgewählt wird. Das ganze sollte so lange Laufen bis in Zelle A kein Wert mehr steht. Also der nachfolgende Code muss jedesmal durchlaufen werden bis in Zell A nix mehr steht.
    Vielen Dank Werner

    Visual Basic-Quellcode

    1. Private Sub CommandButton4_Click()
    2. Application.ScreenUpdating = False
    3. Dim KundenDatei As Workbook
    4. Set KundenDatei = Workbooks.Open("C:\Users\werner\Desktop\Rechnung\Kunden.xlsx")
    5. Worksheets(1).Range("A2").Select
    6. Selection.Copy
    7. Windows("Rechnungtest").Activate
    8. Range("A9").Select
    9. ActiveSheet.Paste
    10. Set KundenDatei = Workbooks.Open("C:\Users\werner\Desktop\Rechnung\Kunden.xlsx")
    11. Worksheets(1).Range("B2").Select
    12. Selection.Copy
    13. Windows("Rechnungtest").Activate
    14. Range("A10").Select
    15. ActiveSheet.Paste
    16. Set KundenDatei = Workbooks.Open("C:\Users\werner\Desktop\Rechnung\Kunden.xlsx")
    17. Worksheets(1).Range("C2").Select
    18. Selection.Copy
    19. Windows("Rechnungtest").Activate
    20. Range("A11").Select
    21. ActiveSheet.Paste
    22. Set KundenDatei = Workbooks.Open("C:\Users\werner\Desktop\Rechnung\Kunden.xlsx")
    23. Worksheets(1).Range("D2").Select
    24. Selection.Copy
    25. Windows("Rechnungtest").Activate
    26. Range("A13").Select
    27. ActiveSheet.Paste
    28. Set KundenDatei = Workbooks.Open("C:\Users\werner\Desktop\Rechnung\Kunden.xlsx")
    29. Worksheets(1).Range("E2").Select
    30. Selection.Copy
    31. Windows("Rechnungtest").Activate
    32. Range("A14").Select
    33. ActiveSheet.Paste
    34. Set KundenDatei = Workbooks.Open("C:\Users\werner\Desktop\Rechnung\Kunden.xlsx")
    35. Worksheets(1).Range("F2").Select
    36. Selection.Copy
    37. Windows("Rechnungtest").Activate
    38. Range("A21").Select
    39. ActiveSheet.Paste
    40. Set KundenDatei = Workbooks.Open("C:\Users\werner\Desktop\Rechnung\Kunden.xlsx")
    41. Worksheets(1).Range("G2").Select
    42. Selection.Copy
    43. Windows("Rechnungtest").Activate
    44. Range("A19").Select
    45. ActiveSheet.Paste
    46. Set KundenDatei = Workbooks.Open("C:\Users\werner\Desktop\Rechnung\Kunden.xlsx")
    47. Worksheets(1).Range("H2").Select
    48. Selection.Copy
    49. Windows("Rechnungtest").Activate
    50. Range("D27").Select
    51. ActiveSheet.Paste
    52. Set KundenDatei = Workbooks.Open("C:\Users\werner\Desktop\Rechnung\Kunden.xlsx")
    53. Worksheets(1).Range("I2").Select
    54. Selection.Copy
    55. Windows("Rechnungtest").Activate
    56. Range("C27").Select
    57. ActiveSheet.Paste
    58. Set KundenDatei = Workbooks.Open("C:\Users\werner\Desktop\Rechnung\Kunden.xlsx")
    59. Worksheets(1).Range("J2").Select
    60. Selection.Copy
    61. Windows("Rechnungtest").Activate
    62. Range("B27").Select
    63. ActiveSheet.Paste
    64. KundenDatei.Close
    65. End Sub


    Edit by Agent: VB-tag eingefügt

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Agent“ ()

    Du sollst den VB Tag des Forum benutzen, denn dann sieht das ganze um einiges angenehmer aus. Nämlich ungefähr so:

    Visual Basic-Quellcode

    1. Private Sub CommandButton4_Click()
    2. Application.ScreenUpdating = False
    3. Dim KundenDatei As Workbook
    4. Set KundenDatei = Workbooks.Open("C:\Users\werner\Desktop\Rechnung\Kunden.xlsx")
    5. Worksheets(1).Range("A2").Select

    Also ist der Code unübersichtlich?
    Sorry, aber vielleicht hab ich´s überlesen :wacko: aber WIE kann ich ihn für euch leichter lesbar machen?
    Bitte seid nachsichtig mit mir! Ich hab ein privates Projekt und will das endlich beenden. Natürlich möchte ich auch in Zukunft das eine oder andere in VBA erstellen, deshalb ist es mir wichtig zu wissen was ich falsch mache und wie ich´s besser machen soll.
    Vielen Dank für eure Nachsicht! Werner

    hallo werner

    ich denke du brauchst nicht jedesmal ie kundendatei neu setzen,

    was die anderen meinten ist einfach nurhier im forum solltest du mit den vb tags arbeiten

    die gehen so:

    Visual Basic-Quellcode

    1. [vb]
    2. das ist ein vb tag

    ende vbtag
    [/vb]

    wie genau willst du die schleife denn machen ?
    Das ist meine Signatur und sie wird wunderbar sein!

    Danke für die Antwort zur Schleife

    Ich hab mit Unterstützung jetzt den Code folgendermaßen geändert. Aber anstatt dass sich das Excel-eigene Speichern unter Fenster öffnet und den Neuen Dateinamen einträgt und wieder schließt, wird ein "Datei speichern als" Fenster geöffnet und er versucht die Datei als xps Dokument abzuspeichern und verlangt auch noch einen Namen. Gebe ich einen Namen habe ich im Ordner dann die Datei z.B. als Hans Maier.xlsm und als Hans Maier.xps gespeichert bekommen. Breche ich ab stürzt die ganze Schleife mit ab. Ich kann das nicht mehr nachvollziehen. Vielleicht hast du ja einen Vorschlag? Ist Das richtig mit den Tag?

    Visual Basic-Quellcode

    1. Private Sub CommandButton4_Click()
    3. Dim wbkKundenDatei As Workbook
    4. Dim wbkSerienbrief As Workbook
    5. Dim wksZiel As Worksheet
    6. Dim lngZeile As Long
    7. Dim wksQuelle As Worksheet
    8. Dim lngLetzteZeile As Long
    9. Dim strDateiname As String
    10. Dim lngX As Long
    12. Application.ScreenUpdating = False
    13. Set wbkSerienbrief = Workbooks("Serienbrief.xls")
    14. Set wksZiel = wbkSerienbrief.Worksheets("Tabelle1")
    16. Set wbkKundenDatei = Workbooks.Open("C:\Users\werner\Desktop\Rechnung\Kunden")
    17. Set wksQuelle = wbkKundenDatei.Worksheets("Tabelle1")
    18. lngLetzteZeile = wksQuelle.Cells(wksQuelle.Rows.Count, 1).End(xlUp).Row
    20. For lngZeile = 2 To lngLetzteZeile
    21. wksZiel.Cells(9, 1).Value = wksQuelle.Cells(lngZeile, 1).Value
    22. wksZiel.Cells(10, 1).Value = wksQuelle.Cells(lngZeile, 2).Value
    23. 'usw.
    24. 'usw. Hier werden weitere Kundendaten eingetragen
    25. 'usw.
    27. strDateiname = wksQuelle.Cells(lngZeile, 1).Value
    28. DoEvents
    29. wksZiel.PrintOut Copies:=3
    30. For lngX = 1 To 5000
    31. DoEvents
    32. Next
    33. wksZiel.SaveAs Filename:="C:\Users\werner\desktop\Rechnung\Grabpflege\" & strDateiname & ".xlsm"
    34. Next
    35. wbkKundenDatei.Close False
    37. End Sub

    strDateiname ist eine Variable die du für den Dateinamen einsetzt

    Visual Basic-Quellcode

    1. strDateiname = wksQuelle.Cells(lngZeile, 1).Value 'Namen zuweisen
    3. wksZiel.SaveAs Filename:="C:\Users\werner\desktop\Rechnung\Grabpflege\" & strDateiname & ".xlsm" <-hier benutzt du ihn

    wenn strDateiname keinen Wert hat, schlägt das Speichern logischerweise fehl.

    Visual Basic-Quellcode

    1. strDateiname = wksQuelle.Cells(lngZeile, 1).Value
    2. msgbox strDateiname
    3. DoEvents

    so könntest du mal überprüfen ob der dateiname nicht leer ist, bzw was er genau ist
    desweiteren sollten die dateinamen unterschiedich sein, da er sonst immer fragt, ob die vorhandene datei überschrieben werden soll
    Das ist meine Signatur und sie wird wunderbar sein!

    MsgBox

    Also der Tipp zum überprüfen ist ja genial, Danke!
    Die msgBox gibt genau den Testnamen -Hans Maier- aus, unter dem die Datei gespeichert werden soll.
    Ich hab auch schon folgendes versucht:
    Dim strDateinamen ersetzt durch Dim Neuer_Dateiname
    und anstatt strDateiname ... hab ich Neuer_Dateiname = wksQuelle... eingesetzt
    Funktioniert auch nicht! Immer wieder kommt das Fenster "Datei speichern als" das nicht erwünscht ist. ????????
    Bin weiterhin für jede Anregung offen und probier noch einiges aus.
    Danke, Werner!

    PrintOut löst den Fehler aus

    Ich hab jetzt jede mögl. Konstellation durchgespielt und es hat nichts funktioniert.
    Wenn ich aber den PrintOut Befehl deaktiviere funktioniert alles wunderbar.
    Allerdings weiß ich keinen anderen PrintOut Befehl. Wenn du einen hättest wär´s nicht schlecht.
    Ich such jetzt noch ein bißchen rum, muß aber bald weg.
    Bis dann Werner

Facebook
Telefonspende