cope method of worksheet class failed error - working code suddenly stopped working...

mysticmario

Active Member
Joined
Nov 10, 2021
Messages
323
Office Version
  1. 365
Platform
  1. Windows
Any has an idea why this occurs?
VBA Code:
Private Sub bezb_Click()
Dim narzutr As String
Dim narzutm As String
Dim wName As String
Dim pName As String
Dim cell As Range
Dim fname As String, wb As Workbook, project As String
narzutr = 1.15
pName = Range("C3").Value
wName = "Faktury" + Left(pName, 5)
fname = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*")
Set wb = Workbooks.Open(fname)
    For Each sh In wb.Sheets
        If Application.CountA(sh.Cells) > 0 Then
            sh.Copy After:=ThisWorkbook.Sheets(Sheets.Count)
         End If
    Exit For
    Next
    Application.DisplayAlerts = False
        wb.Close True
    Application.DisplayAlerts = True
1668667116343.png
1668667145170.png
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
I know the issue - can't fix it.
I have hidden sheets in this wb, therefore it tries to copy that which is impossible
I can even see that sh=Arkusz2
1668668035906.png
For this particular workbook sheet that i want to copy is "Arkusz9"
How do I force this code to grab first visible sheet?
 
Upvote 0
How do I force this code to grab first visible sheet?
Hi,
try adding a sheet visibility check in your code

Rich (BB code):
   Dim sh As Worksheet
    For Each sh In wb.Worksheets
        If Application.CountA(sh.Cells) > 0 Then
          If sh.Visible Then sh.Copy After:=ThisWorkbook.Sheets(Sheets.Count): Exit For
         End If
    Next sh

Dave
 
Upvote 0
Hi,
try adding a sheet visibility check in your code

Rich (BB code):
   Dim sh As Worksheet
    For Each sh In wb.Worksheets
        If Application.CountA(sh.Cells) > 0 Then
          If sh.Visible Then sh.Copy After:=ThisWorkbook.Sheets(Sheets.Count): Exit For
         End If
    Next sh

Dave
same error, and it still shows that sh=arkusz2 not arkusz9
 
Upvote 0
If you are looking to copy a specific sheet name then modify code to test for existence of the sheet

VBA Code:
  Dim sh As Worksheet
 
    For Each sh In wb.Worksheets
        If sh.Name = "arkusz9" Then
            sh.Visible = xlSheetVisible
            sh.Copy After:=ThisWorkbook.Sheets(Sheets.Count): Exit For
         End If
    Next sh

'rest of code

Dave
 
Upvote 0
Solution
If you are looking to copy a specific sheet name then modify code to test for existence of the sheet

VBA Code:
  Dim sh As Worksheet
 
    For Each sh In wb.Worksheets
        If sh.Name = "arkusz9" Then
            sh.Visible = xlSheetVisible
            sh.Copy After:=ThisWorkbook.Sheets(Sheets.Count): Exit For
         End If
    Next sh

'rest of code

Dave
 
Upvote 0
here's the entire code:
VBA Code:
Private Sub bezb_Click()
Dim narzutr As String
Dim narzutm As String
Dim wName As String
Dim pName As String
Dim rsName As String
Dim cell As Range
Dim fname As String, wb As Workbook, project As String
Dim sh As Worksheet
narzutr = 1.15
pName = Range("C3").Value
wName = "Faktury" + Left(pName, 5)
rsName = "Godziny" + Left(pName, 5)
fname = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*")
Set wb = Workbooks.Open(fname)
For Each sh In wb.Worksheets
        If sh.Name = "Wycena z dokładnymi materiałami" Then
            sh.Visible = xlSheetVisible
            sh.Copy After:=ThisWorkbook.Sheets(Sheets.Count): Exit For
        End If

    Next sh
    Application.DisplayAlerts = False
        wb.Close True
    Application.DisplayAlerts = True
  
    'm2'
    ActiveSheet.Columns("C:C").Select
Set cell = Selection.Find(what:="RAZEM m2*", After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

If cell Is Nothing Then
    Sheets(rsName).Range("Y43").Value = 0
Else
    Sheets(rsName).Range("Y43").Value = cell.Offset(0, 1).Value
   
End If
'--------'
'1.POMIARY'
ActiveSheet.Columns("D:D").Select
Set cell = Selection.Find(what:="POMIARY", After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

If cell Is Nothing Then
    Sheets(rsName).Range("S11").Value = 0
    Sheets(rsName).Range("T11").Value = 0
Else
    Sheets(rsName).Range("S11").Value = cell.Offset(0, 4).Value
    Sheets(rsName).Range("T11").Value = cell.Offset(0, 13).Value
    Sheets(rsName).Range("V11").Value = cell.Offset(0, 6).Value
End If

'------'

'2.ORGANIZACJA'
ActiveSheet.Columns("D:D").Select
Set cell = Selection.Find(what:="ORGANIZACJA*", After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

If cell Is Nothing Then
    Sheets(rsName).Range("S12").Value = 0
    Sheets(rsName).Range("T12").Value = 0
Else
    Sheets(rsName).Range("S12").Value = cell.Offset(0, 4).Value
    Sheets(rsName).Range("T12").Value = cell.Offset(0, 13).Value
    Sheets(rsName).Range("V12").Value = cell.Offset(0, 6).Value
End If

'------'
'3.PLANY PRODUKCYJNE'
ActiveSheet.Columns("D:D").Select
Set cell = Selection.Find(what:="PLANY PRODUKCYJNE*", After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

If cell Is Nothing Then
    Sheets(rsName).Range("S13").Value = 0
    Sheets(rsName).Range("T13").Value = 0
Else
    Sheets(rsName).Range("S13").Value = cell.Offset(0, 1).Value
    Sheets(rsName).Range("T13").Value = cell.Offset(0, 9).Value
    Sheets(rsName).Range("V13").Value = cell.Offset(0, 3).Value
End If

'------'
'4.PRACA CNC'
ActiveSheet.Columns("D:D").Select
Set cell = Selection.Find(what:="PRACA CNC*", After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

If cell Is Nothing Then
    Sheets(rsName).Range("S14").Value = 0
    Sheets(rsName).Range("T14").Value = 0
Else
    Sheets(rsName).Range("S14").Value = cell.Offset(0, 1).Value
    Sheets(rsName).Range("T14").Value = cell.Offset(0, 9).Value
    Sheets(rsName).Range("V14").Value = cell.Offset(0, 3).Value
End If

'------'
'5.PRACA WARSZTAT'
ActiveSheet.Columns("D:D").Select
Set cell = Selection.Find(what:="PRACA WARSZTAT*", After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

If cell Is Nothing Then
    Sheets(rsName).Range("S15").Value = 0
    Sheets(rsName).Range("T15").Value = 0
Else
    Sheets(rsName).Range("S15").Value = cell.Offset(0, 1).Value
    Sheets(rsName).Range("T15").Value = cell.Offset(0, 9).Value
    Sheets(rsName).Range("V15").Value = cell.Offset(0, 3).Value
End If

'------'
'6.ROZŁOŻENIE I ZŁOŻENIE DO MALOWANIA'
ActiveSheet.Columns("D:D").Select
Set cell = Selection.Find(what:="ROZŁOŻENIE I ZŁOŻENIE DO MALOWANIA*", After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

If cell Is Nothing Then
    Sheets(rsName).Range("S16").Value = 0
    Sheets(rsName).Range("T16").Value = 0
Else
    Sheets(rsName).Range("S16").Value = cell.Offset(0, 1).Value
    Sheets(rsName).Range("T16").Value = cell.Offset(0, 9).Value
    Sheets(rsName).Range("V16").Value = cell.Offset(0, 3).Value
End If

'------'
'7.ZABEZPIECZENIE MEBLA'
ActiveSheet.Columns("D:D").Select
Set cell = Selection.Find(what:="ZABEZPIECZENIE MEBLA*", After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

If cell Is Nothing Then
    Sheets(rsName).Range("S17").Value = 0
    Sheets(rsName).Range("T17").Value = 0
Else
    Sheets(rsName).Range("S17").Value = cell.Offset(0, 1).Value
    Sheets(rsName).Range("T17").Value = cell.Offset(0, 9).Value
    Sheets(rsName).Range("V17").Value = cell.Offset(0, 3).Value
End If

'------'
'8.MONTAŻ'
ActiveSheet.Columns("D:D").Select
Set cell = Selection.Find(what:="MONTAŻ", After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

If cell Is Nothing Then
    Sheets(rsName).Range("S18").Value = 0
    Sheets(rsName).Range("T18").Value = 0
Else
    Sheets(rsName).Range("S18").Value = cell.Offset(0, 1).Value
    Sheets(rsName).Range("T18").Value = cell.Offset(0, 9).Value
    Sheets(rsName).Range("V18").Value = cell.Offset(0, 3).Value
   
End If
Sheets("Wycena z dokładnymi materiałami").Activate
Sheets(rsName).Activate
'------'
'SUMA ZAŁOŻEŃ ZA ROBOCIZNE MINUS TRANSPORT'

ActiveSheet.Range("T159").FormulaR1C1 = "=SUMIF(C[-16],""R O B O C I Z N A*"",C[-4])"
ActiveSheet.Range("T160").FormulaR1C1 = "=SUMIF(C[-16],""TRANSPORT*"",C[-4])"
ActiveSheet.Range("T161").FormulaR1C1 = "=R[-2]C-R[-1]C"
Sheets(LastSheet).Range("T19").Value = Range("T161").Value

'------'

'9.LAKIERNIA'
ActiveSheet.Range("X2").FormulaR1C1 = "=SUMIF(C[-20],""CENA ZA m2 LAKIER*"",C[-8])"
ActiveSheet.Range("X3").FormulaR1C1 = "=SUMIF(C[-20],""CENA ZA m2 LAKIER*"",C[-16])"
Sheets(LastSheet).Range("Q21").Value = Range("X3").Value
Sheets(LastSheet).Range("R21").Value = Range("X2").Value
'------'
'MATERIAŁY'
Sheets(LastSheet).Range("T36").Value = Sheets(wName).Range("J31").Value
'MARIANUS + FarBlak'
Sheets(LastSheet).Range("W36").Value = Sheets(wName).Range("M10").Value
ActiveSheet.Range("X4").FormulaR1C1 = "=SUMIF(C[-20],""CENA ZA m2 PŁYTY*"",C[-8])"
ActiveSheet.Range("X5").FormulaR1C1 = "=SUMIF(C[-20],""CENA ZA PCV*"",C[-8])"
ActiveSheet.Range("X6").FormulaR1C1 = "=SUMIF(C[-20],""A K C E S O R I A*"",C[-8])"
ActiveSheet.Range("X8").FormulaR1C1 = "=SUMIF(C[-20],""DODATEK:*"",C[-8])"
ActiveSheet.Range("X9").FormulaR1C1 = "=SUM(R[-5]C:R[-1]C)"
'TRANSPORT'
ActiveSheet.Range("X12").FormulaR1C1 = "=SUMIF(C[-20],""TRANSPORT*"",C[-8])"
Sheets(LastSheet).Range("Q37").Value = Range("X12").Value
Sheets(LastSheet).Range("R37").Value = Sheets(wName).Range("M13").Value
'------'

Sheets(LastSheet).Range("S21").FormulaR1C1 = "=RC[-2]*2"
Sheets(LastSheet).Range("U21") = "Bezbarwny"
Sheets(LastSheet).Range("Q22").Value = Range("X9").Value
'------'

ActiveSheet.Move After:=Sheets(Sheets.Count)
Sheets(rsName).Activate
Range("Q36:S25").NumberFormat = "#,##0.00 $"
Range("Y26:Y42").NumberFormat = "#,##0.00 $"
Range("R23").NumberFormat = "#,##0.00 $"
Range("T23").NumberFormat = "#,##0.00 $"
Range("Y21").NumberFormat = "#,##0.00 $"
Range("W21").NumberFormat = "#,##0.00 $"
Range("R21,T21,S26,Q37,R37").NumberFormat = "#,##0.00 $"
Range("Y31").NumberFormat = "#,##0.00 $"
Range("Y43").NumberFormat = "0,00"
Range("Q22").NumberFormat = ";;;"
Range("T36").NumberFormat = ";;;"
'Call money
'Application.DisplayAlerts = False
'Sheets(Sheets.Count).Delete
'Application.DisplayAlerts = True
End Sub
there are some redundand stuff still in it but that doesnt change teh fact that it does nto copy the sheet and throw random numbers oin the end.
Also when i go line by line (F8)
after lines: fname = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*") Set wb = Workbooks.Open(fname)
the code seems to just auto execute till the end, but somethign goes wrong at soem point coz sheet("Wycena z dokładnymi materiałami")
should end up at the end of the workbook where it is copied to beacse i commented out ast 4 lines where it should be deleted.
 
Upvote 0
Slight correction the sheet is being copied but to the begining of workbook which is very weird
 
Upvote 0
so your primary issue is resolved?



try qualifying sheets.count & see if resolves

VBA Code:
sh.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count): Exit For

Dave
@ EDIT nevermind I had a typo thx


ye sprimary issue resolved, but gettign this to last place is not working error 424 Object required



1668675580120.png
 
Upvote 0

Forum statistics

Threads
1,215,098
Messages
6,123,082
Members
449,094
Latest member
mystic19

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