Трабла с переносом данных...

[winfacks]

В общем то такое дело:
При переносе данных с нескольких листов в один посредством вот такой функции:
Private Sub KB2_Click()

Application.ScreenUpdating = False: On Error Resume Next
KB1_Click
Dim sh As Worksheet, r As Range, ra As Range, dat As Range
Set dat = Cells.Range("a1")

For Each sh In ThisWorkbook.Worksheets
If sh.Name Like Not "*Свод*" Then
For Each cell In sh.Range("f:f").SpecialCells(xlCell TypeConstants).Cells
If cell <= dat Then
Set ra = Intersect(cell.EntireRow, sh.Range("a:ah"))
ra.Copy
Me.Range("a65000").End(xlUp).Offset (1).PasteSpecial xlPasteValues
End If
Next cell
End If
Next sh
Me.[a1].Select
Application.CutCopyMode = False

End Sub
Напроч изменяються форматы данных, что переносяться, причем в хаотичном порядке.
Интересно - кто то сталкивался с таким несчастьем аль нет? А если сталкивался то - ПАМАГЫТЕ Плиииз....

[EducatedFool]

Private Sub KB2_Click()
    Application.ScreenUpdating = False: On Error Resume Next
    KB1_Click
    Dim sh As Worksheet, r As Range, ra As Range, dat As Range
    Set dat = Cells.Range("a1")

    For Each sh In ThisWorkbook.Worksheets
        If sh.Name Like Not "*Свод*" Then
            For Each cell In sh.Range("f:f").SpecialCells(xlCellTypeConstants).Cells
                If cell <= dat Then
                    Set ra = Intersect(cell.EntireRow, sh.Range("a:ah"))
                    ra.Copy Me.Range("a65000").End(xlUp).Offset(1).Resize(, ra.Cells.Count)
                End If
            Next cell
        End If
    Next sh
    Me.[a1].Select
End Sub

Ну или просто в строке
Me.Range("a65000").End(xlUp).Offset (1).PasteSpecial xlPasteValues
уберите xlPasteValues (или замените на xlPasteAll)

[winfacks]

Фигня получилася - вставляет хаотический вариант форматов в любом варианте
Может посмотрите в файлике?
юзер admin
пароль 000
пароль на проект 111111

А ... лист - "свод"

[winfacks]

а еще похоже надо как то буфер обмена очищать ... он все валит в ексель Даже мое общение по аське туды пошло (скопировал в буфер серед нажмакать кнопку на обновление данных)

[EducatedFool]

Мой конвертер форматов не смог открыть Ваш файл.

Возьмите за правило выкладывать файлы в формате Excel 2003

а еще похоже надо как то буфер обмена очищать ...

Не надо его заполнять, тогда и чистить не придётся.

При правильно организованном копировании диапазонов ячеек использование буфера обмена требуется крайне редко.

[winfacks]

Тисяча извинениев многоуважаемый Сенсей, Переконвертил

[EducatedFool]

Может, попробуете так:

Private Sub KB1_Click()
    Application.ScreenUpdating = False: Me.[a3:ah60000].ClearContents
End Sub

Private Sub KB2_Click()
    Application.ScreenUpdating = False: On Error Resume Next
    KB1_Click
    Dim sh As Worksheet, r As Range, ra As Range, dat As Range
    Set dat = Cells.Range("a1")
    
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name Like Not "*Свод*" Then
        For Each cell In sh.Range("f:f").SpecialCells(xlCellTypeConstants).Cells
            If cell <= dat Then
                Set ra = Intersect(cell.EntireRow, sh.Range("a:ah"))
                Me.Range("a65000").End(xlUp).Offset(1).Resize(, ra.Cells.Count).Value = ra.Value
            End If
        Next cell
        End If
    Next sh
    Me.[a1].Select
End Sub

В этом случае на итоговый лист переносятся только значения.
Так и не понял, что требуется - копировать вместе с форматами, или наоборот - без форматов?

Напроч изменяються форматы данных, что переносяться, причем в хаотичном порядке.

Хоть бы написали, форматы каких ячеек изменяются
(какой формат был до запуска макроса, и какой - после)

[winfacks]

Попробовал последний вариант.
Сделал сбор данных (нажамкал на княпочку) и...
Почему то в столбец (допустим R - "сумма акта") перенеслись значения числа как в варианте текста, числовом , так и в варианте дата-время
Хотя в исходных данных такого нет
Так не совсем красиво обьяснить получаеться - видеть надо
Ну и по остальным столбцам с цифрами тоже бардак тот же

[winfacks]

все - ушел стреляться, приду с дыркой в башке минут через 7

[EducatedFool]

Так не совсем красиво обьяснить получаеться - видеть надо

Вы бы хоть защиту с листов сняли - а то даже не посмотреть формат исходных ячеек на листах...

А вообще, я не знаю, как решить вашу проблему.
В таких случаях я обычно считывал диапазон в массив, в цикле для отдельных столбцов массива производил замену запятой на точку, и т.д., и только потом записывал массив на лист. В итоге добивался результата, но как-то это всё неправильно.
Наверняка есть более простой способ, но мне он неизвестен.

Могу лишь предложить в качестве решения ручное копирование ячеек (по одной)
Долго, но зато работает...

Может, другие форумчане подскажут решение?