.Cells(Rows.Count, "B").End(xlUp).Row
SaSchu
ohne Eure Hilfe komme ich nicht weiter.
Ich habe eine Tabelle aus der Daten in eine andere Datei kopiert werden sollen. Dazu gibt es ein Makro das das Öffnen einer zusätzlichen (Ziel-)Datei bewirkt. Dann wird in dieser Datei eine bestimmte Zeile gesucht und dann 1000 Zeilen gelöscht (nur als Sicherheit, falls die Datei mal aus Versehen überspeichert wurde). Das klappt bis dahin auch alles. Nun soll aber der eigentliche Kopiervorgang passieren. Und zwar in dem ich bestimmte Spalten der Quelldatei in die Zieldatei kopiere.
So soll z. B. B3 bis ENDE (nur benutzte Zeilen) kopiert werden und dann der Inhalt in die Zeile nach der Zeile in der Nr steht eingefügt werden. In diesem Fall (aber eher die Ausnahme) auch in Spalte B.
Vorgestellt hatte ich mir das Ganze so, aber der Kopierteil funktioniert nicht:
Sub kopieren()
Dim oXlSM As Workbook, oXML As Workbook
Const sListZeichen$ = " "
Dim i, j, k As Long
Dim Lz As Long
Dim vntDatNam As Variant
Application.ScreenUpdating = False
Const sNeuerPfad As String = "\\xxx.xxx.xx.xx\Projekte\"
If ChDirUNC(sNeuerPfad) Then
Do
MsgBox "Bitte öffnen Sie die passende Datei."
vntDatNam = Application.GetOpenFilename("XML-Dateien (*.xml), *.xml")
If vntDatNam = False Then
If MsgBox("Wollen Sie die Anwendung hier abbrechen?", vbYesNo, "Abbruch?") = vbYes _
Then
MsgBox "Die Ausführung wird auf Ihren Wunsch abgebrochen!", vbCritical, "Abbruch!"
Exit Sub
End If
End If
Loop Until vntDatNam False
Else
MsgBox "Die Ausführung wird wegen eines Fehlers abgebrochen!", vbCritical, "Fehler!"
End If
Set oXML = Workbooks.Open(Filename:=vntDatNam)
Set oXlSM = ThisWorkbook 'ThisWorkbook = die xlsm-Datei, in der dieser Code steht
With Sheets("neue Zustandsbeschreibungen")
For i = .Cells(65536, 1).End(xlUp).Row To 1 Step -1
If .Cells(i, 1).Text = "Nr" Then j = i
Next i
For k = 1000 To j + 1 Step -1
Rows(k).EntireRow.Delete
Next k
End With
With oXlSM.Sheets("Mängel vor der Abnahme")
Lz = .Cells(Rows.Count, "B").End(xlUp).Row
Range("B3:B" & Lz).Copy oXML.Sheets("neue Zustandsbeschreibungen").Range(k, 2)
End With
Application.ScreenUpdating = True
End Sub
Ich bekomme dann die Fehlermeldung:
Laufzeifehler '1004':
Anwendungs- oder objektdefinierter Fehler
Die Meldung bezieht sich auf diese Zeile:
Range("B3:B" & Lz).Copy oXML.Sheets("neue Zustandsbeschreibungen").Range(k, 2)
Könnt Ihr meinen Fehler entdecken?
Vielen Dank & Gruß
SaSchu