Hallo Zusammen,
ich bin VBA Anfängerin und habe folgende Aufgabe, die meine aktuellen Kenntnisse echt übersteigt...
Es gibt einen Ordner mit diversen Excel Dateien, alle gleich aufgebaut. Aus jeder .xlsx soll B4:B97 kopiert werden und in eine andere Excel Datei als Zeile eingefügt werden. Der Vorgang soll wiederholt werden, bis keine auszulesenden Excel Dateien mehr im Ordner sind.
Ich habe nun schon viel recherchiert und unterschiedliche Codes ausprobiert die ich im Netz gefunden habe, z.B. diesen hier – der funktioniert leider nicht und fügt auch nur eine Spalte ein. Ich dachte ich teste das erstmal, aber klappt leider auch nicht. Also falls mir jemand diesen Code umschreiben oder einen neuen zur Verfügung stellen kann, wäre ich super super Dankbar!
Viele Grüße
Kerstin
Sub Daten_kopieren()
Dim Pfad_Q As String, Dateiname_Q As String, iCol As Long
Dim Pfad_Z As String, Dateiname_Z As String
Dim SourceRange As Range, DestinationRange As Range
'Application.ScreenUpdating = False
Pfad_Q = "H:\OPTIKO\Projektantr?ge"
Pfad_Z = "H:\OPTIKO\Projektliste"
Dateiname_Z = Dir(Pfad_Z & "Zieldatei_mit_M.xlsm")
Dateiname_Q = Dir$(Pfad_Q & "*.xlsx")
While Len(Dateiname_Q) 'solange du Zeichen in Dateiname hast, also nicht null bist, bleib in der Schleife
Workbooks.Open Filename:=Pfad_Q & Dateiname_Q '?ffne die Quellen in H:\OPTIKO\Projektantr?ge.xlsm
iCol = Workbooks(Dateiname_Z).Sheets("Projektliste").Range("XFD2").End(xlToLeft).Offset(0, 1).Column
'icol nimmt man um das kopierte spalte neben spalte einzuf?gen (Achtung, das hier noch ?ndern weil soll in Zeile)
Set SourceRange = Workbooks(Dateiname_Q).Sheets("Projektantrag").Range("B4:B97")
' kopiere Daten aus der Quelle
Set DestinationRange = Workbooks(Dateiname_Z).Sheets("Projektliste").Cells(4, iCol).Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
DestinationRange.Value = SourceRange.Value
Application.DisplayAlerts = False 'etwaige Dialogfenster sollen geschlossen werden
Workbooks(Dateiname_Q).Close SaveChanges:=False 'auch m?chte ich die ?nderungen in den der Reihe nach zu ?ffnenden Dokumenten (f?r den Kopiervorgang) nicht speichern
Dateiname = Dir$
Wend
Application.DisplayAlerts = True 'nach dem Ende der Schleife d?rfen Dialogfenster wieder angezeigt werden
End Sub
|