Alshaikhli Ответов: 1

Копирование строк с одного листа на шаблон без потери форматирования

Я искал, но не смог найти ничего, связанного с моим желанием.

Я использую vba для копирования ячеек с одного листа 1 на лист 2 с некоторыми условиями, и он работает правильно. Теперь я сталкиваюсь с проблемой (потеря форматирования), когда копирую его на другой лист, который включает шаблон.
что мне нужно, чтобы скопировать ячейки без потери форматирования шаблона?
Спасибо

Что я уже пробовал:

Sub CopyData2()
Dim srcWsh As Worksheet, dstWsh As Worksheet
Dim i As Integer, j As Integer
 
On Error GoTo Err_CopyData2
 
'define context
Set srcWsh = ThisWorkbook.Worksheets("Sheet1")
Set dstWsh = ThisWorkbook.Worksheets("Sheet2")
 
'clear range before you start copying
dstWsh.Range("A6:S10000").Clear
 
'starting rows
i = 2
j = 2
'loop though the data
Do While srcWsh.Range("A3" & i) <> ""
    'go to skip soubroutine if Level is equal to 1
    If srcWsh.Range("S" & i) = 1 Then GoTo SkipThisRow
    'copy set of columns - in this case A to D, but it might be: A, C, E, G
    With dstWsh
        .Range("A" & j) = srcWsh.Range("A" & i)
        .Range("B" & j) = srcWsh.Range("B" & i)
        .Range("C" & j) = srcWsh.Range("C" & i)
        .Range("S" & j) = srcWsh.Range("S" & i)
    End With
    'increase row number in Sheet2
    j = j + 1
'skip subroutine
SkipThisRow:
    'increase row number in Sheet1 i have tried but i a, losing my template formla
    i = i + 1
Loop
 
'exit subroutine
Exit_CopyData2:
    On Error Resume Next
    Set srcWsh = Nothing
    Set dstWsh = Nothing
    Exit Sub
 
'error handler
Err_CopyData2:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_CopyData2
End Sub

1 Ответов

Рейтинг:
1

CHill60

По иронии судьбы, решение, которое я опубликовал на ваш предыдущий вопрос Скопируйте столбцы с условием[^] также копирует форматы. Он не самый эффективный-производительность намного выше при использовании принятого решения, но, по крайней мере, он копирует все подряд.

Если вы "знаете", как изначально были отформатированы ячейки, то можете просто повторно применить форматирование

Если весь столбец отформатирован таким же образом (т. е. ячейка A2 имеет тот же формат, что и ячейка A3 имеет тот же формат, что и ячейка A4 и т. д.), то вы можете скопировать форматирование столбца следующим образом:

Private Sub Formats()
'Assumes source columns are mapped from A to A, F to B etc.
    Dim srcWsh As Worksheet, dstWsh As Worksheet
    Set srcWsh = ThisWorkbook.Worksheets(1)
    Set dstWsh = ThisWorkbook.Worksheets(2)
    
    srcWsh.Range("A:A").Copy
    dstWsh.Range("A:A").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
  
    srcWsh.Range("F:F").Copy
    dstWsh.Range("B:B").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
    srcWsh.Range("H:H").Copy
    dstWsh.Range("C:C").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
    srcWsh.Range("M:M").Copy
    dstWsh.Range("D:D").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub

Или вы можете использовать что-то похожее на мой оригинальный ответ (без выбора и активации сейчас :))
public Sub CopyColumns()
 
    Dim srcWsh As Worksheet, dstWsh As Worksheet
    Set srcWsh = ThisWorkbook.Worksheets(1)
    Set dstWsh = ThisWorkbook.Worksheets(2)
 
    Dim targetRow As Integer
    targetRow = 1
    
    Dim sourceRow As Integer
    For sourceRow = 1 To srcWsh.UsedRange.Rows.Count

        If srcWsh.Range("M" + CStr(sourceRow)).Value2 > 1 Then
            
            srcWsh.Range("A" + CStr(sourceRow) + ",F" + CStr(sourceRow) + ",H" + CStr(sourceRow) + ",M" + CStr(sourceRow)).Copy
            dstWsh.Range("A" + CStr(targetRow)).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            targetRow = targetRow + 1
        End If
    Next
    
End Sub