Hallo, ich habe folgenden Code verfasst, der Daten aus verschiedenen Dateien hin- und her kopieren soll und schlussendlich Daten formatieren soll. Eigentlich nichts aufregendes. Leider hat sich wohl dabei im letzten Teil ein Fehler eingeschlichen. Bei der ersten angegebenen Möglichkeit läuft das Makro voll durch, er löscht allerdings keine leeren Zeilen heraus.
Bei der zweiten Möglichkeit zeigt er mir die Fehlermeldung Typen unverträglich an. Ich habe da auch schon versucht, die Typen auszutauschen, allerdings es auch noch nicht hinbekommen.
Hat vielleicht jemand eine Ahnung, woran es liegt? Vielen Dank schon einmal und einen schönen Tag!!!
Nic
Sub Artikel_übertragen()
Dim Zeilenende As Integer
Dim loeschen As Double ‘(Integer???)
'öffnen Datei im entsprechenden Laufwerk
Workbooks.Open "E:\Artikel.xlsx"
'Festlegen von letzter Zeile in zu importierender Tabelle in Spalte B, 'wo ist der letzte Eintrag in Spalte B
'Datei Artikel, Spalte B
Zeilenende = Workbooks("Artikel").Sheets("Artikel").Cells(Rows.Count, 2).End(xlUp).Row
'löschen von bereits bestehendem Input
'Datei Principal, Sheet Artikel, Spalte C und E
Workbooks("Principal").Sheets("Artikel").Range("C5:C200").ClearContents
Workbooks("Principal").Sheets("Artikel").Range("E5:E200").ClearContents
'Import Inhalt von Artikel -Datei und Übertrag in Principal
'Datei Artikel, Spalte B/C
Workbooks("Artikel").Sheets("Artikel").Range("B3:B" & Zeilenende).Copy
Workbooks("Principal").Sheets("Artikel").Range("C5").PasteSpecial
'Import Inhalt von Artikel -Datei und Übertrag in Principal
'Datei Artikel Spalte C/E
Workbooks("Artikel").Sheets("Artikel").Range("C3:C" & Zeilenende).Copy
Workbooks("Principal").Sheets("Artikel").Range("E5").PasteSpecial
'Anlegen eines Tabellenblattes mit Name "HT"
Workbooks("Artikel").Sheets.Add
ActiveSheet.Name = "HT"
'Neue Artikel werden aus der Principal kopiert und in HT übertragen
Workbooks("Principal").Sheets("Artikel").Range("K5:M100").Copy
Workbooks(“Artikel").Sheets("HT").Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'PROBLEMATIK: alle Zeilen werden gelöscht, welche in Spalte A keinen Inhalt haben
'1. MÖGLICHKEIT:
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
*2: MÖGLICHKEIT:
For loeschen = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(loeschen, 1).Value = "" Then
Rows(loeschen).Delete
End If
Next loeschen
End Sub
|