ОК, у меня здесь что-то работает:
Функция CopyVisible проходит по списку объектов и проверяет, видна ли строка, если это так, описание и все изображения пересекаются с ячейкой. Это происходит в правильном формате, если копировать более одной ячейки с изображением в нем, это запутано по неизвестной мне причине.
Option Explicit ' use this
Public Sub CopyVisible()
Dim SSheet As Worksheet ' Source
Dim TSheet As Worksheet ' Target
Dim Scell As Range ' Target
Dim Tcell As Range 'Source
Dim Tbl As ListObject
Dim offset As Integer
Dim Pic As Shape
Dim Picrng As Range
Set TSheet = Worksheets("QuotationPrint")
Set SSheet = Worksheets("oferta stal")
Set Tbl = SSheet.ListObjects(1)
TSheet.Range("b8:o300").ClearContents 'remove everything below row 8
'Call DeletePicAll
Set Tcell = TSheet.Range("c8")
offset = 10 ' "from c8 to o8 the offset is 10
For Each Scell In Tbl.ListColumns(1).DataBodyRange ' loop through table
If IsVisible(Scell)(1, 1) Then ' only copy if visible
'description
Scell.Copy
Tcell.PasteSpecial Paste:=xlPasteAllUsingSourceTheme ', SkipBlanks:=True
Tcell.EntireRow.AutoFit
'image
For Each Pic In SSheet.Shapes
Set Picrng = Range(Pic.TopLeftCell.Address & ":" & Pic.BottomRightCell.Address)
If Not Intersect(Picrng, Scell.offset(0, 1)) Is Nothing Then
Pic.Copy
Tcell.offset(0, offset).PasteSpecial
End If
Next
Set Tcell = Tcell.offset(1, 0)
End If
Next Scell
End Sub
Эта функция была скопирована с Cpearson и помогает определить, видна ли ячейка или нет. Может также использоваться для диапазона.
Public Function IsVisible(InRange As Range) As Boolean()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsVisible
' This function returns an array of Boolean values indicating whether the
' corresponding cell in InRange is visible.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim R As Range
Dim Arr() As Boolean
Dim RNdx As Integer
Dim CNdx As Integer
ReDim Arr(1 To InRange.Rows.Count, 1 To InRange.Columns.Count)
For RNdx = 1 To InRange.Rows.Count
For CNdx = 1 To InRange.Columns.Count
Set R = InRange(RNdx, CNdx)
If R.EntireRow.Hidden = True Or R.EntireColumn.Hidden = True Then
Arr(RNdx, CNdx) = False
Else
Arr(RNdx, CNdx) = True
End If
Next CNdx
Next RNdx
IsVisible = Arr
End Function
В целом проблема должна быть решена с этим. Несколько советов в конце: объявите свои переменные и заставьте себя сделать это, используя Option Explicit try , чтобы не использовать select и активировать , а если вы используете listobjects, используйте возможность циклически проходить по listrows listcolumns или databodyrange.