Microsoft Excel

Herbers Excel/VBA-Archiv

Kopie eines Bereichs Eintr transform. in neuem AB | Herbers Excel-Forum


Betrifft: Kopie eines Bereichs Eintr transform. in neuem AB von: Reinhard K. Köhler
Geschrieben am: 09.02.2012 18:50:13

Liebe Experten,

ich bin aufgeschmissen, trotz Forum und Herber CDs.

Ich versuche aus diesen Teilen eine

Sub zusammenzustöpseln, und daran scheitere ich.
Ich habe einen Bereich im 1. AB, in dem formularmäßig Daten eingetragen werden sollen, (B4:B9)  _
den ich per Commandbutton in ein 2. AB zeilenmäßig eintragen möchte, um darüber Auswertungen zu fahren. Das klappt irgendwie nicht.
Das ist was ich habe. Hilfe ist sehr willkommen. Vielen Dank!

Sub Testuebertrag()
'
' Testuebertrag Makro
'

    Dim Zelle As Range, wks As Worksheet
    Set wks = Sheets("Liste")
    With wks
     
      'Letzte Zeile in Spalte A ermitteln
      Set Zelle = .Cells(.Rows.Count, 1).End(xlUp)
      'Zeile kopieren und in nächste einfügen
      
     
      
    Sheets("Form").Range("B4:B9").Copy
    Sheets("Liste").Select
    Zelle.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True 'Übertrag der Eintragswerte auf die Listezeile
   .Cells(Zelle, 1).Select
    Selection.NumberFormat = "m/d/yyyy" 'Formatieren der Datumszeile als kurzes Datum
    Application.CutCopyMode = False
    Sheets("Liste").Range(.Cells(Zelle, 7)).Value = Date 'Eintrag des Datums
Sheets("Liste").Cells.Columns.AutoFit 'automatisches Anpassen der Spaltenbreite
    End With
End Sub

  

Betrifft: AW: Kopie eines Bereichs Eintr transform. in neuem AB von: Dirk
Geschrieben am: 09.02.2012 20:13:40

Hallo Reinhard.

mit dem With musst du etwas aufpassen, das ist hier eigendlich total überflüssig

Du ermittelst ja mit

Set Zelle = .Cells(.Rows.Count, 1).End(xlUp)

Die Letzte von unten belegte Zelle
das ist wie du es auch richtig deklariert hattest ein Range.
wenn du aber mit Cells(zeile, spalte) etwas nachen möchtest musst du auch eine Zeilen und spaltennummer angeben.
Cells(Zelle.Row, 7) z.b.

Hier einmal dein Makro ohne Fehler
Sub Testuebertrag()
'
' Testuebertrag Makro
'

    Dim Zelle As Range, wks As Worksheet
    Set wks = Sheets("Liste")
    With wks
     
      'Letzte Zeile in Spalte A ermitteln
      Set Zelle = .Cells(.Rows.Count, 1).End(xlUp)
      'Zeile kopieren und in nächste einfügen

    Sheets("Form").Range("B4:B9").Copy
    Sheets("Liste").Select
    Zelle.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True 'Übertrag der Eintragswerte auf die Listezeile
   Application.CutCopyMode = False
   .Cells(Zelle.Row, 7).Select
    Selection.NumberFormat = "m/d/yyyy" 'Formatieren der Datumszeile als kurzes Datum
    
    .Cells(Zelle.Row, 7).Value = Date 'Eintrag des Datums
Sheets("Liste").Cells.Columns.AutoFit 'automatisches Anpassen der Spaltenbreite
    End With
End Sub
Du solltest da aber den ganzen quatsch mit select raunehmen.
ein einmal vorab geschossenes Sheets("Name").select reicht aus um alles von hier aus zu steuern.

hier mal eine etwas gekürtzte Version deines Makros (ich habe nur rausgestrichen was man nicht braucht)
Sub test()
     Sheets("Liste").Select
    Dim Zelle As Range
      Set Zelle = Cells(Rows.Count, 1).End(xlUp)
    Sheets("Form").Range("B4:B9").Copy
    Zelle.PasteSpecial Transpose:=True
  Application.CutCopyMode = False
 Cells(Zelle.Row, 7).NumberFormat = "m/d/yyyy" 'Formatieren der Datumszeile als kurzes Datum
Cells(Zelle.Row, 7) = Date 'Eintrag des Datums
Sheets("Liste").Cells.Columns.AutoFit 'automatisches Anpassen der Spaltenbreite
End Sub
Gruß
Dirk


Beiträge aus den Excel-Beispielen zum Thema "Kopie eines Bereichs Eintr transform. in neuem AB"