"object doesn't support this property or method"

[KhallP]

"object doesn't support this property or method"

can anyone help me?


If sh.Name = "QEC 1.2 - montagem" Or sh.Name = "QEC 2.2 -SALA LIMPA" Or sh.Name = "QEC 2.4 Logística" Or sh.Name = "QEC 4.1 - MONTAGEM MANUAL(past)" Or sh.Name = "QEC 4.2 - Desmoldagem" Or sh.Name = "QEC 4,3 - RTM" Or sh.Name = "QEC 4,4 - HOT DRAPE" Then
If Range("H" & CStr(k)).Value = "" Then
Workbooks(myRecentFile).Worksheets(counter).Range("W110").Copy
Workbooks("EEC QEC.xlsm").Worksheets(counter2).Range("H" & CStr(k)).Paste
Workbooks(myRecentFile).Worksheets(counter).Range("AI110").Copy
Workbooks("EEC QEC.xlsm").Worksheets(counter2).Range("I" & CStr(k)).Offset(0, 1).Paste

Else
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
res = res + 1
Loop

Workbooks(myRecentFile).Worksheets(counter).Range("W110").Copy

Error
-----------------------------------------------------------------------------------------
Workbooks("EEC QEC.xlsm").Worksheets(counter2).Range("H" & CStr(k + res)).Paste
------------------------------------------------------------------------------------------

Workbooks(myRecentFile).Worksheets(counter).Range("AI110").Copy
Workbooks("EEC QEC.xlsm").Worksheets(counter2).Range("I" & CStr(k + res)).Offset(0, 1).Paste

End If

 

[steve the fish]

Presume thats happening on the paste? Replace .Paste with .PasteSpecial xlPasteValues

 

[KhallP]

Presume thats happening on the paste? Replace .Paste with .PasteSpecial xlPasteValues

shows this

 

[HaHoBe]

Hi,

 If Range("H & CStr(k + 1)").Value = "" Then

should read

 If Range("H" & k + 1).Value = "" Then

feom this thread

Ciao,
Holger

 

[HaHoBe]

Hi, KhallP,

please use code-tags for the display of procedures.

Inside your code you use the explicit name of a workbook as well as ActiveWorkbook, you Select a sheet (unnessray as I might think) and work with ActiveCell.

As I had invested some time reworking the code please have a look at this sniplet (not tested, and I´m still wondering on why to depend on the index numbers for sheets inside workbooks to copy contents between them)

Dim myRecentFile As String

Public Sub WriteCells_210514()
'https://www.mrexcel.com/board/threads/object-doesnt-support-this-property-or-method.1170938/
 
  Dim wkbRecent           As Workbook
  Dim wkbTarget           As Workbook

  Dim wksList             As Worksheet
  Dim wksActRecent        As Worksheet
  Dim wksActTarget        As Worksheet

  Dim lngLastList         As Long
  Dim lngCounterRecent    As Long
  Dim lngCounterTarget    As Long
  Dim lngOffset           As Long

  Set wkbRecent = Workbooks(myRecentFile)
  Set wkbTarget = Workbooks("EEC QEC.xlsm")
  Set wksList = wkbTarget.Sheets("QEC 1.2 - montagem")
 
  lngOffset = 1
  lngLastList = wksList.Cells(Rows.Count, "H").End(xlUp).Row
 
  For lngCounterRecent = 1 To wkbRecent.Worksheets.Count
    For lngCounterTarget = 1 To wkbTarget.Worksheets.Count
      Set wksActRecent = wkbRecent.Worksheets(lngCounterRecent)
      Set wksActTarget = wkbTarget.Worksheets(lngCounterTarget)
      Select Case wksActRecent.Name
        Case "QEC 12 IF", "QEC 22 IF", "QEC 24 IF", "QEC 41 IF", "QEC 42 IF", "QEC 43 IF", "QEC 44 IF"
          Select Case wksActTarget.Name
            Case "QEC 1.2 - montagem", "QEC 2.2 -SALA LIMPA", "QEC 2.4 Logística", "QEC 4.1 - MONTAGEM MANUAL(past)", _
                    "QEC 4.2 - Desmoldagem", "QEC 4,3 - RTM", "QEC 4,4 - HOT DRAPE"
              If wksList.Range("H" & lngLastList + 1).Value = "" Then
                wksActRecent.Range("W110").Copy
                wksActTarget.Range("H" & lngLastList + 1).Paste
                ''maybe have a go with this if the values transported aren´t formulas
                'wksActTarget.Range("H" & lngLastList + 1).Value = wksActRecent.Range("W110").Value
                wksActRecent.Range("AI110").Copy
                wksActTarget.Range("I" & lngLastList + 1).Offset(0, 1).Paste
              Else
                Do Until wksList.Range("H" & lngLastList + lngOffset).Value = ""
                  lngOffset = lngOffset + 1
                Loop
                wksActRecent.Range("W110").Copy
                wksActTarget.Range("H" & lngLastList + lngOffset + 1).Paste
                wksActRecent.Range("AI110").Copy
                wksActTarget.Range("I" & lngLastList + lngOffset + 1).Offset(0, 1).Paste
              End If
          End Select
      End Select
    Next lngCounterTarget
  Next lngCounterRecent
 
  Set wksActTarget = Nothing
  Set wksActRecent = Nothing
  Set wksList = Nothing
  Set wkbTarget = Nothing
  Set wkbRecent = Nothing
 
End Sub

Ciao,
Holger

 

[HaHoBe]

Thinking about it this modification should reduce the number of loops (still untested):

Public Sub WriteCells_210514_3()
'https://www.mrexcel.com/board/threads/object-doesnt-support-this-property-or-method.1170938/
  
  Dim wkbRecent           As Workbook
  Dim wkbTarget           As Workbook
  
  Dim wksList             As Worksheet
  Dim wksActRecent        As Worksheet
  Dim wksActTarget        As Worksheet
  
  Dim lngLastList         As Long
  Dim lngCounterRecent    As Long
  Dim lngCounterTarget    As Long
  Dim lngOffset           As Long

  Set wkbRecent = Workbooks(myRecentFile)
  Set wkbTarget = Workbooks("EEC QEC.xlsm")
  Set wksList = wkbTarget.Sheets("QEC 1.2 - montagem")
  
  lngOffset = 0
  lngLastList = wksList.Cells(Rows.Count, "H").End(xlUp).Row
  
  For lngCounterRecent = 1 To wkbRecent.Worksheets.Count
    Set wksActRecent = wkbRecent.Worksheets(lngCounterRecent)
    Select Case wksActRecent.Name
      Case "QEC 12 IF", "QEC 22 IF", "QEC 24 IF", "QEC 41 IF", "QEC 42 IF", "QEC 43 IF", "QEC 44 IF"
        For lngCounterTarget = 1 To wkbTarget.Worksheets.Count
          Set wksActTarget = wkbTarget.Worksheets(lngCounterTarget)
          Select Case wksActTarget.Name
            Case "QEC 1.2 - montagem", "QEC 2.2 -SALA LIMPA", "QEC 2.4 Logística", "QEC 4.1 - MONTAGEM MANUAL(past)", _
                    "QEC 4.2 - Desmoldagem", "QEC 4,3 - RTM", "QEC 4,4 - HOT DRAPE"
              If wksList.Range("H" & lngLastList + 1).Value = "" Then
                wksActRecent.Range("W110").Copy
                wksActTarget.Range("H" & lngLastList + 1).Paste
                ''maybe have a go with this if the values transported aren´t formulas
                'wksActTarget.Range("H" & lngLastList + 1).Value = wksActRecent.Range("W110").Value
                wksActRecent.Range("AI110").Copy
                wksActTarget.Range("I" & lngLastList + 1).Offset(0, 1).Paste
              Else
                Do Until wksList.Range("H" & lngLastList + lngOffset).Value = ""
                  lngOffset = lngOffset + 1
                Loop
                wksActRecent.Range("W110").Copy
                wksActTarget.Range("H" & lngLastList + lngOffset + 1).Paste
                wksActRecent.Range("AI110").Copy
                wksActTarget.Range("I" & lngLastList + lngOffset + 1).Offset(0, 1).Paste
              End If
          End Select
        Next lngCounterTarget
    End Select
  Next lngCounterRecent
    
  Set wksActTarget = Nothing
  Set wksActRecent = Nothing
  Set wksList = Nothing
  Set wkbTarget = Nothing
  Set wkbRecent = Nothing
    
End Sub

No comments from the Debugger came up...

Holger