Help with copy and paste from another sheet.

R

rickybid

New Member
Joined
Sep 3, 2014
Messages
7
Hi All,

I have created a code to copy some data from one workbook to another.

This works good, however I think it could be faster and someone will probably know a much faster way of coding.

Because I am pretty new to VBA, I think someone will be able to help me.

As said before the code works good, but takes to long to process.

Any help will be appreciated.

Code: 
Sub Import_Report()


'Created by Ricky Bidjai, AUG 2014
'This macro opens the selected file for transport and uses the text to columns function


'********** Variables declaration
Dim fNameAndPath As Variant, Export_Wbk As Workbook


fNameAndPath = Application.GetOpenFilename(Title:="Select File To Be Opened")


If fNameAndPath = False Then Exit Sub


'********** Initialisation
On Error GoTo Error_Handling
Application.DisplayStatusBar = True
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False




Dim this_wbk As Workbook
Dim FirstBlankCellA As Range
Dim FirstBlankCellB As Range
Dim FirstBlankCellC As Range
Dim FirstBlankCellD As Range
Dim FirstBlankCellE As Range
Dim FirstBlankCellF As Range
Dim FirstBlankCellG As Range
Dim FirstBlankCellI As Range
Dim FirstBlankCellK As Range
Dim FirstBlankCellM As Range
Dim FirstBlankCellO As Range
Dim FirstBlankCellQ As Range
Dim FirstBlankCellS As Range
Dim FirstBlankCellU As Range
Dim FirstBlankCellW As Range
Dim FirstBlankCellY As Range
Dim FirstBlankCellAA As Range
Dim FirstBlankCellAC As Range
Dim FirstBlankCellAE As Range
Dim FirstBlankCellAG As Range
Dim FirstBlankCellAI As Range
Dim FirstBlankCellAK As Range
Dim FirstBlankCellAM As Range
Dim FirstBlankCellAO As Range
Dim FirstBlankCellAQ As Range
Dim FirstBlankCellAS As Range
Dim FirstBlankCellAU As Range
Dim FirstBlankCellAW As Range
Dim FirstBlankCellAY As Range
Dim FirstBlankCellBA As Range
Dim FirstBlankCellBC As Range
Dim FirstBlankCellBE As Range
Dim FirstBlankCellBG As Range
Dim FirstBlankCellBI As Range
Dim FirstBlankCellBK As Range
Dim FirstBlankCellBM As Range
Dim FirstBlankCellBO As Range
Dim FirstBlankCellBQ As Range
Dim FirstBlankCellBS As Range
Dim FirstBlankCellBU As Range
Dim FirstBlankCellBX As Range
Dim FirstBlankCellBY As Range
Dim FirstBlankCellBZ As Range
Dim FirstBlankCellCA As Range
Dim FirstBlankCellCB As Range
Dim FirstBlankCellCC As Range
Dim FirstBlankCellCD As Range
Dim FirstBlankCellCE As Range








Set FirstBlankCellA = Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellB = Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellC = Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellD = Range("D" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellE = Range("E" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellF = Range("F" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellG = Range("G" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellI = Range("I" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellK = Range("K" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellM = Range("M" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellO = Range("O" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellQ = Range("Q" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellS = Range("S" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellU = Range("U" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellW = Range("W" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellY = Range("Y" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellAA = Range("AA" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellAC = Range("AC" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellAE = Range("AE" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellAG = Range("AG" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellAI = Range("AI" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellAK = Range("AK" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellAM = Range("AM" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellAO = Range("AO" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellAQ = Range("AQ" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellAS = Range("AS" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellAU = Range("AU" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellAW = Range("AW" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellAY = Range("AY" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBA = Range("BA" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBC = Range("BC" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBE = Range("BE" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBG = Range("BG" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBI = Range("BI" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBK = Range("BK" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBM = Range("BM" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBO = Range("BO" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBQ = Range("BQ" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBS = Range("BS" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBU = Range("BU" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBX = Range("BX" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBY = Range("BY" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellBZ = Range("BZ" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellCA = Range("CA" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellCB = Range("CB" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellCC = Range("CC" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellCD = Range("CD" & Rows.Count).End(xlUp).Offset(1, 0)
Set FirstBlankCellCE = Range("CE" & Rows.Count).End(xlUp).Offset(1, 0)






Set this_wbk = ThisWorkbook
Set Export_Wbk = Workbooks.Open(fNameAndPath)




'import cut off date
Export_Wbk.Sheets("General Information (2)").Activate
Range("C3").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-1],10)"
Range("C3").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellA.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


    
'import date
Export_Wbk.Sheets("General Information (2)").Activate
Range("B5").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellB.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False




'import institution
Export_Wbk.Sheets("General Information (2)").Activate
Range("B9").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellC.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import contact person
Export_Wbk.Sheets("General Information (2)").Activate
Range("B11").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellD.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import email
Export_Wbk.Sheets("General Information (2)").Activate
Range("B13").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellE.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import received date
Export_Wbk.Sheets("General Information (2)").Activate
Range("B19").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellF.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False




'import 1.1
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C4:D4").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellG.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'import 1.2
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C5:D5").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellI.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'import 1.3
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C6:D6").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellK.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False




'import 1.4
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C7:D7").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellM.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 1.5
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C8:D8").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellO.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 1.6
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C9:D9").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellQ.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 1.7
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C10:D10").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellS.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 1.8
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C11:D11").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellU.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 1.9
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C12:D12").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellW.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False




'import 2.1
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C14:D14").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellY.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 2.2
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C15:D15").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellAA.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 2.3
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C16:D16").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellAC.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False




'import 3.1
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C18:D18").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellAE.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 3.2
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C19:D19").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellAG.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 3.3
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C20:D20").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellAI.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 3.4
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C21:D21").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellAK.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 3.5
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C22:D22").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellAM.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 4.1
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C24:D24").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellAO.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 4.2
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C25:D25").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellAQ.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 4.3
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C26:D26").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellAS.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 4.4
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C27:D27").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellAU.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 4.5
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C28:D28").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellAW.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 4.6
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C29:D29").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellAY.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 4.7
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C30:D30").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBA.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 4.8
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C31:D31").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBC.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 4.9
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C32:D32").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBE.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 4.10
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C33:D33").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBG.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 5.1
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C35:D35").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBI.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'import 5.2
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C36:D36").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBK.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'import 5.3
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C37:D37").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBM.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'import 5.4
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C38:D38").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBO.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'import 5.5
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C39:D39").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBQ.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'import 5.6
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C40:D40").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBS.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'import 5.7
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C41:D41").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBU.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 6.1 A
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C44").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBU.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 6.1 B
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C45").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBU.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 6.1 C
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C46").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBU.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 6.1 D
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C47").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBU.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 6.1 E
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C48").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBU.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 6.1 F
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C49").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBU.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 6.1 G
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C50").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBU.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'import 6.1 H
Export_Wbk.Sheets("Status Dashboard").Activate
Range("C51").Select
Selection.Copy
this_wbk.Activate
FirstBlankCellBU.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False




With Export_Wbk
Application.CutCopyMode = False
.Close SaveChanges:=False
End With


'********* Error Management & Closing
Closing:
Set Export_Wbk = Nothing
Set this_wbk = Nothing
Set FirstBlankCellA = Nothing
Set FirstBlankCellB = Nothing
Set FirstBlankCellC = Nothing
Set FirstBlankCellD = Nothing
Set FirstBlankCellE = Nothing
Set FirstBlankCellF = Nothing
Set FirstBlankCellG = Nothing
Set FirstBlankCellI = Nothing
Set FirstBlankCellK = Nothing
Set FirstBlankCellM = Nothing
Set FirstBlankCellO = Nothing
Set FirstBlankCellQ = Nothing
Set FirstBlankCellS = Nothing
Set FirstBlankCellU = Nothing
Set FirstBlankCellW = Nothing
Set FirstBlankCellY = Nothing
Set FirstBlankCellAA = Nothing
Set FirstBlankCellAC = Nothing
Set FirstBlankCellAE = Nothing
Set FirstBlankCellAG = Nothing
Set FirstBlankCellAI = Nothing
Set FirstBlankCellAK = Nothing
Set FirstBlankCellAM = Nothing
Set FirstBlankCellAO = Nothing
Set FirstBlankCellAQ = Nothing
Set FirstBlankCellAS = Nothing
Set FirstBlankCellAU = Nothing
Set FirstBlankCellAW = Nothing
Set FirstBlankCellAY = Nothing
Set FirstBlankCellBA = Nothing
Set FirstBlankCellBC = Nothing
Set FirstBlankCellBE = Nothing
Set FirstBlankCellBG = Nothing
Set FirstBlankCellBI = Nothing
Set FirstBlankCellBK = Nothing
Set FirstBlankCellBM = Nothing
Set FirstBlankCellBO = Nothing
Set FirstBlankCellBQ = Nothing
Set FirstBlankCellBS = Nothing
Set FirstBlankCellBU = Nothing
Set FirstBlankCellBX = Nothing
Set FirstBlankCellBY = Nothing
Set FirstBlankCellBZ = Nothing
Set FirstBlankCellCA = Nothing
Set FirstBlankCellCB = Nothing
Set FirstBlankCellCC = Nothing
Set FirstBlankCellCD = Nothing
Set FirstBlankCellCE = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub


Error_Handling:
Application.ScreenUpdating = True
MsgBox "A general error prevented the macro to run accordingly, please contact the ESES Business Support and provide the following error code and message: " & Err.Number & " : " & Err.Description, vbCritical, "Reporting"
GoTo Closing
End Sub
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
.
.

That is a long procedure! Please can you give a summary of exactly what the macro is trying to achieve?..
 
Upvote 0
Hiya
Try removing all the .activate & .Select so this
Code: 
Export_Wbk.Sheets("General Information (2)").Activate
 Range("B5").Select
 Selection.Copy
 this_wbk.Activate
 FirstBlankCellB.Activate
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
becomes this
Code: 
Export_Wbk.Sheets("General Information (2)").Range("B5").Copy
this_wbk.FirstBlankCellB.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
VBA Copy, Paste to Different Workbook, Save as then loop the action through slicer
Replies
1
Views
214
krisoey
K
S
  • Solved
Macro Not running
2 3
Replies
28
Views
603
Joe4
Joe4
G
  • Solved
How do I automatically insert into next blank row..
Replies
2
Views
280
ghrek
G
M
  • Solved
screen keeps flickering and flashing why using macro
Replies
4
Views
343
markswan111
M
S
  • Question
Keep getting an "Error 1004: item could not be found in the OLAP cube" when applying the filter to pivot table
Replies
5
Views
344
RoryA
RoryA

Forum statistics

Threads
1,203,068
Messages
6,053,345
Members
444,654
Latest member
Rich Cohen

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top