Macro VBA giving error when running on different server

Question

Hi,

I have a macro file running in Excel 2010 Standard.

The Macro (.xlsm) works perfectly in one server. When it runs on another server, it giving error on the correct codes sometimes.

'Microsoft excel cannot paste the data'.

The Macro seems unstable. It will success when I close and open and maybe run a few more times.  

I have checked the version of .Net Framework. Both are using the same version 4.0.30319.

Anything I can do to get it success?

Answer 1

I think I've caught most of it. You will notice that when I am writing a cell or range reference inside of an With ... End With statement, I prefix Range with a period like .Range. This means that the range definitely belongs to what is defined as the With. Example:

With wkbk.Sheets("Sheets1")

    .Range("A1")   'refers to A1 on Sheet1 within wrkbk

End With

With wkbk.Sheets("Sheets1")

    Range("A1")   'refers to some A1, could be on Sheet1 or somewhere else

End With

You still had a lot of missing worksheet references. Even if you use .Activate to access a workbook, it isn't a good idea to rely on some worksheet being the one with the focus without defining it explicitly.

I don't know what you mean by "**paste values and descriptions". What are descriptions? Comments? Formats?

Private Sub Workbook_Open()

    Dim wkbk As Workbook, wkbk2 As Workbook, wkbk3 As Workbook

    Dim pvtTable1 As PivotTable

    Dim strYrNm As String

    Dim strMthNm As String

    Dim i As Range, src As Range, QueryRange As Range

    Dim X As Long

    Dim BankingName As String, BankingCode As Long

    Application.DisplayAlerts = False

    Set wkbk = Workbooks.Open("D:\Customer.xlsx", False)

    Set wkbk3 = Workbooks.Open("D:\INST.xlsx", False)

    Set QueryRange = wkbk3.Sheets("Sheet1").Range("A1:B500")

    For Each i In wkbk.Sheets("Sheet1").Range("B:AB,AD:AS,AU:BF").Columns

        With wkbk.Sheets("Sheet1")  ' sheet1 assumed, not in your code

            If Not Intersect(i, .Range("B:AB")) Is Nothing Then

                Set src = Union(.Columns("A"), i, .Columns("AC"), .Columns("BH"))

            ElseIf Not Intersect(i, .Range("AD:AS")) Is Nothing Then

                Set src = Union(.Columns("A"), i, .Columns("AT"), .Columns("BH"))

            Else

                Set src = Union(.Columns("A"), i, .Columns("BG"), .Columns("BH"))

            End If

        End With

        Set wkbk2 = Workbooks.Add

        With wkbk2.Sheets("Sheet1")

            .Name = "Test"

            src.Copy Destination:=.Range("A1")

            .Columns("D:D").Cut

            .Columns("B:B").Insert Shift:=xlToRight

            .Columns("D:D").Cut

            .Columns("C:C").Insert Shift:=xlToRight

            wkbk.Range("B4:B6").Copy Destination:=.Range("B4")

            .Range("C8").Cut Destination:=.Range("C7")

            .Range("D9").Cut Destination:=.Range("D7")

            .Range("8:9").Delete Shift:=xlUp

            .Range("D8:D9").Copy Destination:=.Range("B8:C9")

            BankingName = .Range("D7").Value

            BankingCode = Application.VLookup(BankingName, QueryRange, 2, False)

            .Columns.AutoFit

            .Cells(1, 1).Select

            .Parent.SaveAs Filename:="D:" & BankingCode & "_Customer.xlsx", FileFormat:=51

            .Parent.Close True

        End With

    Set src = nothing

   Next i

    Set QueryRange = Nothing

    wkbk3.Close SaveChanges:=False

    Set wkbk3 = Nothing

    wkbk.Close SaveChanges:=False

    Set wkbk = Nothing

    Application.DisplayAlerts = True

End Sub

Edit: there were some copy and paste problems. I believe I've corrected them now.

Answer 2

I think I provide longer macro to make things clearer.

• wkbk is different as ThisWorkbook (ThisWorkbook opens wkbk)
• Union multiple columns
• PasteSpecial, paste values and descriptions
• wkbk2 will end at the end of the loop
• copy B4:B6 again to fetch the columns names.
• i refers to columns.
• Yes. copying a block of data.

Private Sub Workbook_Open()

    Dim wkbk As Workbook

    Dim wkbk2 As Workbook

    Dim wkbk3 As Workbook

    Dim pvtTable1 As PivotTable

    Dim strYrNm As String

    Dim strMthNm As String

    Dim i As Range

    Dim X As Long

Set wkbk = Workbooks.Open("D:\Customer.xlsx", False)

For Each i In Range("B:AB,AD:AS,AU:BF").Columns

    wkbk.Activate

    If Not Intersect(i, Range("B:AB")) Is Nothing Then

    Union(Columns("A"), i, Columns("AC"), Columns("BH")).Select

    Selection.Copy

    ElseIf Not Intersect(i, Range("AD:AS")) Is Nothing Then

    Union(Columns("A"), i, Columns("AT"), Columns("BH")).Select

    Selection.Copy

    Else

    Union(Columns("A"), i, Columns("BG"), Columns("BH")).Select

    Selection.Copy

    End If

    Set wkbk2 = Workbooks.Add

    With wkbk2

        Application.DisplayAlerts = False

        wkbk2.Sheets("Sheet1").Range("A1").PasteSpecial

        wkbk2.Sheets("Sheet1").Name = "Test"

        Cells(1, 1).Select

        Columns("D:D").Cut

        Columns("B:B").Insert Shift:=xlToRight

        Columns("D:D").Cut

        Columns("C:C").Insert Shift:=xlToRight

        wkbk.Activate

        Range("B4:B6").Copy

        wkbk2.Activate

        Range("B4:B6").PasteSpecial

        wkbk2.Activate

        Range("C8").Cut

        Range("C7").Select

        wkbk2.Sheets("Test").Paste

        Range("D9").Cut

        Range("D7").Select

        wkbk2.Sheets("Test").Paste

        Range("8:9").Delete Shift:=xlUp

        Range("D8:D9").Copy

        Range("B8:C9").PasteSpecial

        Application.DisplayAlerts = False

        Cells(1, 1).Select

        BankingName = Range("D7").Value

        Set wkbk3 = Workbooks.Open("D:\INST.xlsx", False)

        Set QueryRange = wkbk3.Sheets("Sheet1").Range("A1:B500")

        BankingCode = Application.WorksheetFunction.VLookup(BankingName, QueryRange, 2, False)

        wkbk3.Close

        wkbk2.Activate

        Columns.AutoFit

        Cells(1, 1).Select

        wkbk2.SaveAs FileName:="D:" & BankingCode & "_Customer.xlsx", FileFormat:=51

        wkbk2.Close True

        Application.DisplayAlerts = True

    End With

Next i

Application.DisplayAlerts = False

wkbk.Close

Application.DisplayAlerts = True

End Sub

Answer 3

Great. I think I know how to get it good.

Thank you very much.

Despite the macro, may I ask, giving the same set of codes, running it in pc A is success and running in pc B will give error.

(Same version of Excel 2010 standard and .Net Framework version 4.0.30319)

The both pc should have giving same error as above 'Microsoft excel cannot paste the data'.