2016-06-10 5 views
0

Le script fait exactement ce que j'ai besoin de faire, mais il insère la plage d'entrée (A7: B30) dans une seule ligne plutôt que dans le format existant.Entrée de feuille de données Excel insérée comme une seule ligne, pas plusieurs fois

Sub UpdateLogWorksheet() 
    'http://www.contextures.com/xlForm02.html 

    Dim dataWks As Worksheet 
    Dim inputWks As Worksheet 

    Dim nextRow As Long 
    Dim oCol As Long 

    Dim myRng As Range 
    Dim myCopy As String 
    Dim myCell As Range 

    'cells to copy from Input sheet - some contain formulas 
    myCopy = "A7:B30" 

    Set inputWks = Worksheets("Input") 
    Set dataWks = Worksheets("Data") 

    With dataWks 
     nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row 
    End With 

    With inputWks 
     Set myRng = .Range(myCopy) 

    End With 

    With dataWks 
    With .Cells(nextRow, "A") 
     .Value = "" 
     .NumberFormat = "dd/mm/yyyy" 
    End With 
    .Cells(nextRow, "D").Value = "HELLO" 
    oCol = 3 
    For Each myCell In myRng.Cells 
     dataWks.Cells(nextRow, oCol).Value = myCell.Value 
     oCol = oCol + 1 
    Next myCell 
    End With 

    'clear input cells that contain constants 
    With inputWks 
    On Error Resume Next 
    With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants) 
      .ClearContents 
      Application.GoTo .Cells(1) ', Scroll:=True 
    End With 
    On Error GoTo 0 
    End With 
End Sub 

Des idées?

Répondre

0

Essayez de changer:

For Each myCell In myRng.Cells 
    dataWks.Cells(nextRow, oCol).Value = myCell.Value 
    oCol = oCol + 1 
Next myCell 

à

For Each myCell In myRng.Cells 
    dataWks.Range(myCell.Address).Value = myCell.Value 
Next myCell 

qui préserve la mise en page, à savoir les données seront collées dans la même plage il a été copié.