I checked the file extensions and changed the code to look for .xlsm format. It runs perfectly on all but 3 sheets now. Thank you for your help!
Posts by CheckListHobbies
-
-
That is true. Here is the code:
Code
Display MoreSub CopyData() Application.Calculation = xlCalculationManual Application.ScreenUpdating = False ' Select previous version of checklist to transfer data from Dim FName As Variant Dim OldWB As Workbook Dim NewWB As Workbook: Set NewWB = ThisWorkbook Dim ArrayElement As Variant FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls") If FName = False Then Exit Sub End If Set OldWB = Workbooks.Open(FName) Dim SNarray, j ReDim SNarray(1 To OldWB.Sheets.Count) For j = 1 To OldWB.Sheets.Count SNarray(j) = OldWB.Sheets(j).Name If SNarray(j) = "Special Release Booster V1.0" Then OldWB.Sheets(j).Name = "Special Release Booster V1.0" ElseIf SNarray(j) = "Special Release Booster V1.5" Then OldWB.Sheets(j).Name = "Special Release Booster V1.5" ElseIf SNarray(j) = "Great Legend" Then OldWB.Sheets(j).Name = "Great Legend" ElseIf SNarray(j) = "Battle of Omni" Then OldWB.Sheets(j).Name = "Battle of Omni" ElseIf SNarray(j) = "Double Diamond" Then OldWB.Sheets(j).Name = "Double Diamond" ElseIf SNarray(j) = "Gaia Red Starter Deck" Then OldWB.Sheets(j).Name = "Gaia Red Starter Deck" ElseIf SNarray(j) = "Cocytus Breath Starter Deck" Then OldWB.Sheets(j).Name = "Cocytus Breath Starter Deck" ElseIf SNarray(j) = "Heaven's Yellow Starter Deck" Then OldWB.Sheets(j).Name = "Heaven's Yellow Starter Deck" ElseIf SNarray(j) = "Giga Green Starter Deck" Then OldWB.Sheets(j).Name = "Giga Green Starter Deck" ElseIf SNarray(j) = "Machine Black Starter Deck" Then OldWB.Sheets(j).Name = "Machine Black Starter Deck" ElseIf SNarray(j) = "Venomous Violet Starter Deck" Then OldWB.Sheets(j).Name = "Venomous Violet Starter Deck" ElseIf SNarray(j) = "Gallantmon Starter Deck" Then OldWB.Sheets(j).Name = "Gallantmon Starter Deck" ElseIf SNarray(j) = "UlforceVeedramon Starter Deck" Then OldWB.Sheets(j).Name = "UlforceVeedramon Starter Deck" ElseIf SNarray(j) = "Promotion Pack Ver 0.0" Then OldWB.Sheets(j).Name = "Promotion Pack Ver 0.0" ElseIf SNarray(j) = "Dash Pack V 1.0" Then OldWB.Sheets(j).Name = "Dash Pack V 1.0" ElseIf SNarray(j) = "Dash Pack V 1.5" Then OldWB.Sheets(j).Name = "Dash Pack V 1.5" ElseIf SNarray(j) = "Special Box Promotion Pack" Then OldWB.Sheets(j).Name = "Special Box Promotion Pack" ElseIf SNarray(j) = "Tamer Party Event" Then OldWB.Sheets(j).Name = "Tamer Party Event" ElseIf SNarray(j) = "Special Release Memorial Pack" Then OldWB.Sheets(j).Name = "Tamer Battle Pack 1" ElseIf SNarray(j) = "XY Trainer (Noivern)" Then OldWB.Sheets(j).Name = "Tamer Battle Pack 1" ElseIf SNarray(j) = "Official Tournament Pack Vol. 1" Then OldWB.Sheets(j).Name = "Official Tournament Pack Vol. 1" ElseIf SNarray(j) = "Tamer's Evolution Box 1" Then OldWB.Sheets(j).Name = "Tamer's Evolution Box 1" ElseIf SNarray(j) = "Great Dash Pack" Then OldWB.Sheets(j).Name = "Great Dash Pack" ElseIf SNarray(j) = "Premium Pack Set 1" Then OldWB.Sheets(j).Name = "Premium Pack Set 1" ElseIf SNarray(j) = "Great Legend Pre-Release Pack" Then OldWB.Sheets(j).Name = "Great Legend Pre-Release Pack" ElseIf SNarray(j) = "Great Legend Power-Up Pack" Then OldWB.Sheets(j).Name = "Great Legend Power-Up Pack" End If SNarray(j) = OldWB.Sheets(j).Name Next j ' Transfer card data to new workbook from old workbook For i = 7 To NewWB.Sheets.Count For Each ArrayElement In SNarray If NewWB.Sheets(i).Name = ArrayElement Then Dim CardCount As String: CardCount = NewWB.Sheets(i).Range("A" & Rows.Count).End(xlUp).Row On Error Resume Next OldWB.Sheets(ArrayElement).AutoFilter.ShowAllData If NewWB.Sheets(i).Range("M1") = "1st Edition" Then OldWB.Sheets(ArrayElement).Range("G2:G" + CardCount).Copy NewWB.Sheets(i).Range("G2:G" + CardCount).PasteSpecial Paste:=xlPasteValues ElseIf NewWB.Sheets(i).Range("N1") = "1st Edition" Then OldWB.Sheets(ArrayElement).Range("G2:G" + CardCount).Copy NewWB.Sheets(i).Range("G2:G" + CardCount).PasteSpecial Paste:=xlPasteValues ElseIf NewWB.Sheets(i).Range("M1") = "Have" And Mid(OldWB.Sheets("Start").Range("I6"), 2, Len(OldWB.Sheets("Start").Range("I6")) - 1) >= 5.5 Then OldWB.Sheets(ArrayElement).Range("G2:G" + CardCount).Copy NewWB.Sheets(i).Range("G2:G" + CardCount).PasteSpecial Paste:=xlPasteValues End If NewWB.Sheets(i).Activate NewWB.Sheets(i).Range("A1").Select 'NewWB.Sheets(i).ScrollRow = 1 Exit For End If Next ArrayElement Next i Application.DisplayAlerts = False OldWB.Close SaveChanges:=False NewWB.Sheets(4).Activate NewWB.Sheets(4).Range("A1").Select Application.Calculation = xlCalculationAutomatic MsgBox ("Data has been copied! =)") End Sub -
When I click the import button to run the macro, it opens up file explorer to let me select a workbook to import from. However, when testing, I can't see any excel files in any of my folders even though I can see that other Excel files are there in another file explorer window.
The workbook I'm using is a collection checklist of sorts for a card game. Each set has a sheet where you can input the number of a card you own and I have a macro to import those numbers from an old version of the Excel file to the updated version. The file is shared online with some friends that play, so as new sets come out and the main file gets updated, it makes it easier for everyone to keep their lists updated. I'm not very good at coding, as it is not my profession, just something I happened to write for my hobby this one time.
Any help would be appreciated. Thanks in advance!