Microsoft Excel

Herbers Excel/VBA-Archiv

kopieren in erste freie Zelle best. Bereich | Herbers Excel-Forum


Betrifft: kopieren in erste freie Zelle best. Bereich von: Mario
Geschrieben am: 06.02.2012 18:02:07

Hallo liebe Excel-Gemeinde,
vielleicht kann mir jemand helfen.
Ich möchte "selektierte" Daten aus Tabelle1 in Tabelle2 kopieren.
Daten sollen in die erste freie Zeile des Bereichs A6:I17 kopiert werden.
Problem Zellen der Zeile 3 und 4 sind verbunden und ab Zeile 18 Zellen belegt.
Folgender Code funzt nicht:

Dim Loletzte As Long
Range(Selection, Selection.End(xlToRight)).Select
With Worksheets("Tabelle2")
Loletzte = IIf(IsEmpty(.Range("A16")), _
.Range("A16").End(xlUp).Row + 1, 16)
Selection.Copy Destination:=.Cells(Loletzte, 1)
End With
Range("A3").Select

  

Betrifft: AW: kopieren in erste freie Zelle best. Bereich von: Dirk
Geschrieben am: 06.02.2012 19:02:23

Hallo Mario.

wenn die das egal ist ab das Bild kurzzeitig Flackert kannst du z.B. hiermit in die Erste freie Zeile "Wandern" und diese ggf. mit activecell.row ermitteln.

Range("a4").Select
Do While ActiveCell <> ""
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
eine andere Möglichkeit währ z.B über eine find "*" Funktion mit dem option letzer Treffer
so z.B.
Dim ZelleLetzte As Range
  With ThisWorkbook.Sheets("Daten")
    With ThisWorkbook.Sheets("tabelle2"=.Range("a6:a2000")
      Set ZelleLetzte = .Find(what:="*", after:=.Range("A1"), LookIn:=xlValues, _
            lookat:=xlWhole, searchdirection:=xlPrevious)
    End With
wenn du weitere Hilfe brauchst währ eine Beispieldatei ganz vorteilhaft.

Gruß
Dirk


  

Betrifft: AW: kopieren in erste freie Zelle best. Bereich von: Mario
Geschrieben am: 06.02.2012 19:51:02

Hallo Dirk,

vielen Dank für Deine Hilfe.

Hier die entsprechende Datei.
https://www.herber.de/bbs/user/78766.xls
Von Tabelle1 sollen Daten in Tabelle2 kopiert werden.
Gleichzeitig soll eine Sicherheitskopie in Tabelle 3 mit Datum und fortlaufender Bestellnummer angelegt werden.

Ich komme einfach nicht richtig weiter.

Vielen Dank

Mario


  

Betrifft: Ohh Jeh von: Dirk
Geschrieben am: 06.02.2012 21:14:44

Hallo Mario,
Ich denke mal der Code geht schöner, kürzer und mit weniger Selectionen aber er Funktioniert.

Vieleicht hat ein anderer ja ne Idee wie man den noch kürzen kann

Sub test()
Dim i As Integer, art(1 To 5) As String, lnr As String
Dim lfnr As Range

If Sheets("tabelle1").Select Then
Do While ActiveCell.Column <> 1
ActiveCell.Offset(0, -1).Range("A1").Select
Loop
else
Msgbox("Unzulässiges Blatt")
end
End If

For i = 1 To 5
art(i) = ActiveCell
ActiveCell.Offset(0, 1).Range("A1").Select
Next i

Sheets("Tabelle2").Select
Range("a6").Select
LZ
ezlinks
For i = 1 To UBound(art) 'eigendlich Quatsch weil ubound(art) immer 5 ist
ActiveCell = art(i)
ActiveCell.Offset(0, 1).Range("A1").Select
Next i

lnr = Sheets("tabelle2").Range("f2")
    With ThisWorkbook.Sheets("tabelle3").Range("a1:a2000")
      Set lfnr = .Find(what:=lnr, after:=.Range("A1"), LookIn:=xlValues, _
            lookat:=xlWhole, searchdirection:=xlPrevious)
    End With

Sheets("tabelle3").Select
Range("a1").Select
If lfnr Is Nothing Then
LZ
ActiveCell = lnr
ActiveCell(1, 3).Range("A1") = Date  'wieso hier jetzt (1,6) versteh ich gerade auch nicht
End If
LZ
ezlinks
For i = 1 To UBound(art)
ActiveCell = art(i)
ActiveCell.Offset(0, 1).Range("A1").Select
Next i

Sheets("tabelle1").Select
ezlinks
End Sub



Private Sub LZ()
Do While ActiveCell <> ""
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
End Sub



Private Sub ezlinks()
Do While ActiveCell.Column <> 1
ActiveCell.Offset(0, -1).Range("A1").Select
Loop
End Sub

Ach und Räum mal deine Macros auf ist ja grauenhaft wieviel müll du da hast :-D
überflüssige Module kann man mit rechtsklick wieder entfernen.

Wieso deine Macros nicht liefen:
1. Problem verbundene Zellen.
bei Past (einfügen) von Daten in eine solche Zelle meckert Excel die Zellenformatierung an ( ungleiche Breiten oder so)
2. With
With heißt so viel wie mit
da kommt es dann genau auf die Schreibweise an.
hier ein Beispiel

du befindest dich in Sheets("Tabelle1")
with Sheets("tabelle2")
.Range("A1").copy
Range("A1").paste
end With

macht auf den ersten blick keinen sinn, da er die Zelle A1 kopiert und in Zelle A1 einfügt aber der . macht den unterschied
. =With
Er kopiert die Daten aus Sheets("tabelle2").Range("A1") und fügt diese in Range("A1") ein.

Gruß
Dirk


  

Betrifft: AW: Ohh Jeh von: Mario
Geschrieben am: 06.02.2012 21:56:06

Hallo Dirk,

vielen, vielen Dank für die Antwort von Dir.
Funktioniert echt prima.
Habe versucht den Code neben meiner eigendlichen Arbeit zu schreiben.
Ja, deswegen dieses Chaos bei den Makros.
Aber dank Dir bin ich L-I-C-H-T-J-A-H-R-E weiter.

Nochmals vielen Dank Dirk!

Mario


Beiträge aus den Excel-Beispielen zum Thema "kopieren in erste freie Zelle best. Bereich"