2016-03-11 7 views
0

J'ai une feuille de calcul faite dans Excel 2003 (enregistré comme une feuille de calcul .xlsm 2007 de macro activé) qui utilise des requêtes pour obtenir des données de SQL. J'ai fait la feuille de calcul en lecture seule afin que les utilisateurs ne le font pas gâcher mon travail, et utiliser le code suivant pour copier uniquement les valeurs de la feuille de calcul maître à un nouveauTaille de ligne de copie VBA?

Sub NewWB() 
Dim wbNew As Workbook 
Dim wbThis As Workbook 
Dim rng As Range 
Dim wbName As String 
Dim Pic As Picture 

wbName = ThisWorkbook.Name 


Set wbThis = Application.Workbooks(wbName) 
Set rng = wbThis.Worksheets("Report").Range("C1:AZ65336") 
Set wbNew = Workbooks.Add(xlWBATWorksheet) 
Set Pic = wbThis.Worksheets("Report").Pictures("Picture 2") 
With Pic 
    With .ShapeRange 
     .ScaleHeight 1#, msoScaleFromTopLeft 
    .ScaleWidth 1#, msoScaleFromTopLeft 
    End With 
End With 


rng.Copy 

With wbNew 

     .Worksheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats 
     .Worksheets(1).Range("A1").PasteSpecial Paste:=8 
     .Worksheets(1).Range("A1").PasteSpecial xlPasteFormats 
Pic.Copy 
     .Worksheets(1).Paste 
     .SaveAs Filename:=wbThis.Path & "\" & Left(wbName, InStr(wbName, ".") - 1) & _ 
     Format(Date, "_yyyy-mm-dd"), _ 
     FileFormat:=xlWorkbookNormal 
End With 


' wbThis.Close 

End Sub 

Il fonctionne très bien avec une petite problème. Il ne copie pas mes hauteurs de ligne de sorte que le logo que je copie finisse par couvrir une partie des données! Il me semble ahurissant qu'il y aurait un moyen de copier directement les colonnes mais pas du tout de copier les lignes.

Que dois-je faire pour copier la hauteur de ligne, je travaille avec les 100 premières lignes du document.

+0

Vous pouvez parcourir les 100 premières lignes et définir les hauteurs de ligne dans la feuille de destination. –

+2

http://www.exceltip.com/cells-ranges-rows-and-columns-in-vba/copy-row-heights-and-column-widths-using-vba-in-microsoft-excel.html –

+0

Est Y at-il une raison pour laquelle vous ne pouvez pas simplement supprimer les deux premières lignes et ensuite copier la feuille entière? –

Répondre

2

J'ai fait deux nouvelles variables

Dim rngNew as Range 
Dim x As Integer 

Et modifié ma section « Avec wbNew » d'avoir le code suivant

With wbNew 
     .Worksheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats 'Paste only the values and how the values are formatted 
     .Worksheets(1).Range("A1").PasteSpecial Paste:=8 ' Paste the column widths 
     .Worksheets(1).Range("A1").PasteSpecial xlPasteFormats ' Paste cell formats (boarders, colors, etc) 
     x = 1 
     For Each rngNew In .Worksheets(1).Range("A1:A100") ' Set the range in the new worbook 
     rngNew.EntireRow.RowHeight = wbThis.Worksheets("Report").Range("A" & CStr(x)).RowHeight 'Each row in the new workbook equals the equivilant row in the first workbook 
     x = x + 1 
     Next 
     Pic.Copy ' Copy the logo 
     .Worksheets(1).Paste ' Paste the Logo 
     .SaveAs Filename:=wbThis.Path & "\" & Left(wbName, InStr(wbName, ".") - 1) & _ 
     Format(ReportDate, "_yyyy-mm-dd"), _ 
     FileFormat:=xlWorkbookNormal ' Save the workbook as a generic .xls 
End With 

Il est plus brut que je l'aurais espéré et il utilise l'hypothèse que Je commence au premier rang (ce qui est bien pour ce que je fais) mais cela fonctionne à moins d'une meilleure réponse.