VBA in Excel 2010

    Diese Seite verwendet Cookies. Durch die Nutzung unserer Seite erklären Sie sich damit einverstanden, dass wir Cookies setzen. Weitere Informationen

    • VBA in Excel 2010

      Hi Leute,

      ich hab n Problem...

      ein User drückt auf einen Knopf und dann werden aus der aktiven Excel 1-x Zeilenabschnitte in eine neue Excel kopiert.

      ziel soll sein:

      wenn in a28 was stehst soll excel A28:R28 kopieren
      wenn in a29 was stehst soll excel A29:R29 kopieren
      .
      .
      .
      wenn in a33 was stehst soll excel A33:R33 kopieren

      eingefügt soll das ganze bei der neuen tabelle in der ersten freien zeile nach A2, also A(X), und im gleichen Bereich, also A(X):R(X).



      Aktuell bin ich soweit:

      Quellcode

      1. Public Function fncCheckWorkbookOpen(ByVal strName As String) As Boolean
      2. 'Prüft ob Arbeitsmappe geöffnet ist
      3. Dim wb As Workbook
      4. On Error GoTo Fehler
      5. fncCheckWorkbookOpen = True
      6. Set wb = Application.Workbooks(strName)
      7. Fehler:
      8. With Err
      9. Select Case .Number
      10. Case 0 'Alles ok
      11. Case Else
      12. fncCheckWorkbookOpen = False
      13. End Select
      14. End With
      15. End Function
      16. Private Sub CommandButton1_Click()
      17. Dim wbQuelle As Workbook, wksQuelle As Worksheet
      18. Dim wbZiel As Workbook, wksZiel As Worksheet
      19. Dim strZiel As String, strPfadZiel As String
      20. Dim bolOpen As Boolean
      21. Dim Zeile_Z As Long, Zelle_Letzte As Range
      22. If MsgBox("Stunden jetzt speichern?", vbQuestion + vbOKCancel, _
      23. "Speichern Bemusterungsauftrag") = vbCancel Then GoTo Fehler
      24. On Error GoTo Fehler
      25. Set wbQuelle = ActiveWorkbook 'Datei "Laufkarte_zur_Auftragsabwicklung.xlsm"
      26. Set wksQuelle = wbQuelle.Worksheets("Intern")
      27. Application.ScreenUpdating = False
      28. strPfadZiel = "C:\Test" '### anpassen ##!!!
      29. 'strPfadZiel = wbQuelle.Path 'wenn beide Dateien im gleichen Verzeichnis
      30. strZiel = "Test.xlsx"
      31. If fncCheckWorkbookOpen(strZiel) Then
      32. Set wbZiel = Application.Workbooks(strZiel)
      33. bolOpen = True
      34. Else
      35. Set wbZiel = Application.Workbooks.Open(strPfadZiel & Application.PathSeparator _
      36. & strZiel)
      37. bolOpen = False
      38. End If
      39. Set wksZiel = wbZiel.Worksheets("Tabelle1")
      40. With wksZiel
      41. 'nächste Einfüge-Zeile ermitteln
      42. Set Zelle_Letzte = .Cells.Find(What:="*", After:=Range("A1"), _
      43. LookIn:=xlFormulas, lookat:=xlWhole, searchorder:=xlByRows, _
      44. searchdirection:=xlPrevious)
      45. If Zelle_Letzte Is Nothing Then
      46. Zeile_Z = 1
      47. Else
      48. Zeile_Z = Zelle_Letzte.Row + 1
      49. End If
      50. 'Zellinhalte übertragen - noch ohne Überprüfung - nur Werte
      51. wksQuelle.Range("D4:D8").Copy
      52. .Cells(Zeile_Z, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
      53. End With
      54. Application.CutCopyMode = False
      55. If bolOpen = False Then
      56. wbZiel.Close savechanges:=True
      57. End If
      58. Fehler:
      59. Application.ScreenUpdating = True
      60. With Err
      61. Select Case .Number
      62. Case 0 'Alles OK
      63. Case Else
      64. MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
      65. End Select
      66. End With
      67. Set wbZiel = Nothing: Set wksZiel = Nothing: Set Zelle_Letzte = Nothing
      68. Set wbQuelle = Nothing: Set wksQuelle = Nothing
      69. End Sub
      Alles anzeigen




      Der Find und der Copy funktionieren nicht richtig...

      Ich danke echt für eure Hilfe!