Home Copy-Paste Efficiency in a Multiple Workbook loop
 I have a code that I borrowed and modified. It uses a loop to open a set of files one at a time and then copy paste the information I need into a separate file. I borrowed the part that opens the files and loops through each one. I modified it to do all of the copy-pasting. It causes Excel to crash if the selected folder has too many files. Can anyone help me make this more efficient? Or tell me if there is a better way to do this? With fldr .Title = "Select a Folder" .AllowMultiSelect = False .InitialFileName = Application.DefaultFilePath If .Show <> -1 Then GoTo NextCode sItem = .SelectedItems(1) End With strPath = sItem Set fso = CreateObject("Scripting.FileSystemObject") Set fld = fso.GetFolder(strPath) strFile = Dir(strPath & "\*.xls*") Do While strFile <> "" Set wbk = Workbooks.Open _ (Filename:=strPath & "\" & strFile, _ UpdateLinks:=0, _ ReadOnly:=True, _ AddToMRU:=False) nam = wbk.Name Windows(nam).Activate Dim lastRow As String  The files all have a varying amount of entries, but always have more data than needed in the first two columns. There is always the correct amount of data in column H so I chose to start there. There is also a two row header that I don't want to copy.  ' Find # of used rows lastRow = ActiveSheet.Cells(Rows.Count, "H").End(xlUp).Row Range("H" & lastRow).Select rangevar = CDbl(lastRow) rangevar = rangevar - 3 ' Copy/ Paste/ Arrange....  This section is where I think I need to make it more efficient. I am using offset and the range found above to only select the data I want from a specific (but varying) range. I then open the desired location and paste it. I do this 5 times... so simplifying this would be very helpful I believe. Range("A3", Range("A3").Offset(rangevar, 1)).Select Selection.Copy Windows("*** Specific File Name***").Activate Sheets("Master Tab").Select lastRow2 = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1 Range("B" & lastRow2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows(nam).Activate Range("E3", Range("E3").Offset(rangevar, 0)).Select Application.CutCopyMode = False Selection.Copy Windows("*** Specific File Name***").Activate Sheets("Master Tab").Select Range("D" & lastRow2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows(nam).Activate ... 5 more copy and pastes...  Then once The copy pasting is done, the workbook is closed and the loop opens the next one.  wbk.Close (False) strFile = Dir Loop