Bereich befüllen
22.01.2019 11:19:28
Georg
Der folgende Code macht alles korrekt bis zur Zeile "Dim n as Long"
Der läuft zwar durch aber es passiert nichts.
Was will ich? Ich kopiere Werte nach Spalte C und D aus einer anderen Datei.
Die Datei wird zukünftig forlaufend befüllt.
Ist der Kopiervorgang beendet, soll noch das Fachgebiet (Abfrage über Input Box) in Spalte A eingetragen werden, und zwar genau über die Anzahl d. Zeilen, die gerade kopiert wurden. Und das haut nicht hin?
Danke für einen Hinweis, an was es hakt. Gruß G
Sub DatenCopy()
Dim wbQuelle As Workbook
Dim wbZiel As Workbook
Dim strFileName
Dim strfilter As String
Dim loLastRowQuelle As Long
Dim loLastRowZiel As Long
Dim strBereich As String
Dim Fachgebiet As String
'DateiÖffnen Dialog
strfilter = "Excel-Dateien(*.xlsx), *.xlsx" '** Dateifilter definieren
ChDrive "Q"
ChDir "Q:\Testpfad" '** Laufwerk und Pfad definieren, welcher geöffnet werden soll
'** Den im Dialogfeld gewählten Namen auslesen
strFileName = Application.GetOpenFilename(strfilter)
'** Prüfen, ob eine gültige Datei ausgewählt wurde
If strFileName = False Then Exit Sub
'** Gewählte Datei öffnen
Set wbQuelle = Workbooks.Open(strFileName)
Set wbZiel = ThisWorkbook
wbZiel.Activate
loLastRowZiel = wbZiel.Worksheets(1).Cells(Rows.Count, 4).End(xlUp).Row 'Wie weit ist Spalte D _
bisher befüllt
wbQuelle.Activate
loLastRowQuelle = wbQuelle.Worksheets(1).Cells(Rows.Count, 14).End(xlUp).Row
strBereich = Range(Cells(16, 14), Cells(loLastRowQuelle, 15)).Address ' Der Kopierbereich, der _
stimmt so, immer ab Zeile 16 runter
wbQuelle.Worksheets(1).Range(strBereich).Copy
wbZiel.Worksheets(1).Cells(loLastRowZiel + 1, 3).PasteSpecial Paste:=xlPasteValues, Operation:= _
xlNone, _
SkipBlanks:=False, Transpose:=False
With wbZiel.Worksheets(1)
.Columns("C:C").NumberFormat = "#,##0.00"
.Columns("C:D").AutoFit
End With
Application.CutCopyMode = False
Fachgebiet = Application.InputBox("Geben Sie das Fachgebiet ein!")
wbZiel.Activate
Dim n As Long
With wbZiel.Worksheets(1)
For n = 2 To loLastRowZiel
If .Cells(n, 1).Value = "" Then
.Cells(n, 1).Value = Fachgebiet
End If
Next n
End With
End Sub