Дублирование строк данных excel

Question

Этот макрос отлично работает для дублирования строк на основе целочисленного значения в определенном столбце. Как мне получить его, чтобы скопировать форматирование исходных данных?

Sub DuplicateRows() 

Dim currentRow As Integer 
Dim currentNewSheetRow As Integer: currentNewSheetRow = 1 

For currentRow = 1 To 3 'The last row of your data 

    Dim timesToDuplicate As Integer 
    timesToDuplicate = CInt(Sheet1.Range("D" & currentRow).Value2) 

    Dim i As Integer 
    For i = 1 To timesToDuplicate 

     Sheet2.Range("A" & currentNewSheetRow).Value2 = Sheet1.Range("A" & currentRow).Value2 
     Sheet2.Range("B" & currentNewSheetRow).Value2 = Sheet1.Range("B" & currentRow).Value2 
     Sheet2.Range("C" & currentNewSheetRow).Value2 = Sheet1.Range("C" & currentRow).Value2 

     currentNewSheetRow = currentNewSheetRow + 1 

    Next i 

Next currentRow 

End Sub 

Answer 1

Я не совсем понимаю, что вы пытаетесь достичь, но когда я хочу, чтобы скопировать все (формат, стоимость и т.д.) Я использую копирование и PasteSpecial функцию клетки.

Sub DuplicateRows() 

Dim currentRow As Integer 
Dim currentNewSheetRow As Integer: currentNewSheetRow = 1 

For currentRow = 1 To 3 'The last row of your data 

    Dim timesToDuplicate As Integer 
    timesToDuplicate = CInt(Sheet1.Range("D" & currentRow).Value2) 

    Dim i As Integer 
    For i = 1 To timesToDuplicate 

     Sheet1.Range("A" & currentNewSheetRow).Copy 
     Sheet2.Range("A" & currentRow).PasteSpecial (xlPasteAll) 
     Sheet1.Range("B" & currentNewSheetRow).Copy 
     Sheet2.Range("B" & currentRow).PasteSpecial (xlPasteAll) 
     Sheet1.Range("C" & currentNewSheetRow).Copy 
     Sheet2.Range("C" & currentRow).PasteSpecial (xlPasteAll) 

     currentNewSheetRow = currentNewSheetRow + 1 

    Next i 

Next currentRow 

End Sub 

Также рассмотрите возможные параметры функции PasteSpecial для достижения вашего результата.