I have a Main Excel file which i created a macro that collects Information from different Excel files (same Format) Based on some criterias.
Based on the codes somehow you can see what ive been trying to do.
The Code wont work , it takes Long time to perform and it doesnt give me the right Information.
Sub Transfer ()
Call TurnOffStuff
Dim SSl As String
Dim Baureihe As String
Dim Produktionsjahr As String
Dim Garantiejahr As String
Dim LastRow As Long, LastRow2 As Long
Dim erow As Long
Dim i As long, j As Long
Dim filename As String
Dim Tfile As Workbook
filename = Application.GetOpenFilename("Word files (*.xlsm),*.xlsm", , " Select File")
If filename = Empty Then
Exit Sub
End if
Set TFile = Application.Workbooks.Open(filename)
LastRow = ActivateSheet.Range("A" & Rows.Count).End(xlUp).row
LastRow2 = Tfile.Sheets("Transponieren").Range("A" & Rows.Count).End(xlUp).row
For i = 2 To LastRow
SSL = Sheets("Transponieren").Cells(i, "A").value
Baureihe = Sheets("Transponieren").Cells(i, "b").value
Produktionsjahr = Sheets("Transponieren").Cells(i, "c").value
Garantiejahr = Sheets("transponieren").Cells(i, "D").value
For j = 2 To LastRow2
If Sheets("Transponieren").Cells(j, "A").value = SSL And _
Sheets("Transponieren").Cells(j , "B").Value = Baureihe And _
Sheets("Transponieren").Cells(j , "C").Value = Produktionsjahr Then
TFile.Sheets("Transponieren").Range("A" & i & ":E" & i).Copy _
Destination:=ThisWorkbook.Sheets("Transponieren").Range("K" & j)
Application.CutCopyMode = False
Exit For
Endi If
Next j
Next i
Sheets("Transponieren").Activate
Sheets("Transponieren").Range("A1").Select
End Sub
Bookmarks