ich kopiere mit untenstehendem Code Daten aus verschiedenen "Quelldateien" in eine "Zieldatei". Dazu habe ich folgende Fragen:
1) Die Anzahl der zu kopierenden Sheets kann von Projekt zu Projekt variieren, es ist sicher nicht sinnvoll dafür den jeweiligen "Block" (so wie unten) zu duplizieren, sondern das über eine Schleife zu lösen. Das geht wahrscheinlich mit arrays, weiss aber nicht wie...?
2) Es wäre gut, wenn man alle einzugebenden Daten/Variablen (strDatei, strSheet, usw) im Kopf des Codes definiert, so dass man nicht nach unten scrollen muss. Ich ziehe auch in Erwägung, diese Daten aus einem Arbeitsblatt zu lesen, in das man alle notwendigen Daten eingibt (also Projektname, Anzahl der zu kopierenden Sheets, Dateinamen usw)
3) Ist der untenstehende Code "sauber"? Wo gibt es Verbesserungen?
Sub Update()
Dim strBereich As String
Dim strProjekt As String
Dim strOrdner As String
Dim strDatei As String
Dim strSheet As String
strProjekt = "EIP" 'Projektname eintragen'
'Kopieren des 1. Sheets'
strOrdner = "\..\1 Asset List\"
strDatei = "Asset List.xls"
strSheet = "Asset List"
Workbooks.Open Filename:=ThisWorkbook.Path & strOrdner & strProjekt & "_" & strDatei
strBereich = "A1:" & Application.Workbooks(strProjekt & "_" & strDatei).Worksheets(strSheet) _
_
.Cells.SpecialCells(xlCellTypeLastCell).Address
Workbooks(strProjekt & "_" & strDatei).Worksheets(strSheet).Cells.Copy ThisWorkbook. _
Worksheets(strSheet).Cells
ThisWorkbook.Worksheets(strSheet).Range(strBereich).Value = ThisWorkbook.Worksheets( _
strSheet).Range(strBereich).Value
Application.DisplayAlerts = False
Workbooks(strProjekt & "_" & strDatei).Close
Application.DisplayAlerts = True
'Kopieren des 2. Sheets'
strOrdner = "\..\2 Rent Roll\"
strDatei = "Rent Roll.xls"
strSheet = "Rent Roll"
Workbooks.Open Filename:=ThisWorkbook.Path & strOrdner & strProjekt & "_" & strDatei
strBereich = "A1:" & Application.Workbooks(strProjekt & "_" & strDatei).Worksheets(strSheet) _
_
.Cells.SpecialCells(xlCellTypeLastCell).Address
Workbooks(strProjekt & "_" & strDatei).Worksheets(strSheet).Cells.Copy ThisWorkbook. _
Worksheets(strSheet).Cells
ThisWorkbook.Worksheets(strSheet).Range(strBereich).Value = ThisWorkbook.Worksheets( _
strSheet).Range(strBereich).Value
Application.DisplayAlerts = False
Workbooks(strProjekt & "_" & strDatei).Close
Application.DisplayAlerts = True
End Sub
Viele Grüße,
Boris