Spalte ausfüllen mit End(xlUp)
14.09.2020 12:18:44
Fabian
leider scheitere ich an einer eigentlich recht einfachen Aufgabenstellung. Ein Buttonklick soll per Auswahldialog eine Excelmappe öffnen, daraus den Bereich ab A2 bis zur letzten gefüllten Zeile in Spalte W kopieren. Dieser Bereich soll eingefügt werden in die erste nicht beschriftete Zeile in Spalte B der Zieldatei. Die Liste soll sich also dynamisch immer um den Inhalt der ausgewählten Datei ergänzen. Das klappt nicht ganz, im zweiten Durchlauf werden zu wenige Zeilen eingefügt...
Zusätzlich soll links vom eingefügten Block, also in Spalte A, ein Abrufdatum eingefügt werden, welches zuvor per InputBox eingegeben wurde. Auch dieser Bereich muss natürlich dynamisch sein. Leider scheitert mein Code spätestens beim zweiten Durchlauf, weil dort strMaxRow einen seltsamen Wert annimmt...
Sub Schaltfläche1_Klicken()
Dim ImportDatei As Variant
Dim wbImport As Workbook
Dim sTxt As String, sPrompt As String, sDefault As String
Dim lngLast As Long
Dim strMaxrow As Long, strMinrow As Long
Application.ScreenUpdating = True 'Bildschirmaktualisierung für die Laufzeit des Makros _
deaktivieren
'Application.ScreenUpdating = False 'Bildschirmaktualisierung für die Laufzeit des Makros _
deaktivieren
ImportDatei = Application.GetOpenFilename(Title:="SAP Export-Datei auswählen")
If ImportDatei = False Then Exit Sub
sPrompt = "Abrufdatum aus SAP eingeben:"
sDefault = Format(Date - 0, "dd.mm.yyyy")
sTxt = InputBox(prompt:=sPrompt, Default:=sDefault)
'On Error GoTo ERRORHANDLER
'vor Einfügen der Daten MinRow ermitteln, wegen Überschrift +1
strMinrow = Range("B65536").End(xlUp).Row + 1
Set wbImport = Workbooks.Open(ImportDatei)
wbImport.Worksheets("Sheet1").Range("A2:W1000").Copy Destination:=ThisWorkbook.Worksheets(" _
Tabelle2").Range("B65536").End(xlUp).Offset(1, 0)
strMaxrow = Range("B65536").End(xlUp).Row
With ThisWorkbook.Worksheets("Tabelle2")
.Range("A" & strMinrow & ":A" & strMaxrow).FormulaLocal = sTxt
'.Range("A" & strMinrow).AutoFill Destination:=Range("A" & strMinrow & ":A" & strMaxrow)
End With
Application.CutCopyMode = False
wbImport.Close savechanges:=False
Set wbImport = Nothing
strMaxrow = 0
strMinrow = 0
End Sub
Kann mir jemand helfen?