Pasting Formats

[Tmini]

Hi
I have the below code which copies a range data from a workbook and it works well. I just want to copy formatting such as borders and font colour etc. I have tried using .PasteSpecial xlPasteValuesAndNumberFormats as per below but it doesn't seem to work.

= ws.Range("A1:A13").[COLOR=#333333]PasteSpecial xlPasteValuesAndNumberFormats[/COLOR]

Clearly I am doing something wrong and I am unsure where I am going wrong. Is someone able to help me out

     Filename = Split(x(i), "\")(UBound(Split(x(i), "\")))       Set Wb = Workbooks(Filename)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Wb.Sheets("Sheet5")
        On Error GoTo 0
        If Not ws Is Nothing Then
         ws1.Range("A1:A13").Offset(lngrow, 0).Value = ws.Range("A1:A13").Value
         ws1.Range("b1:b13").Offset(lngrow, 0).Value = ws.Range("b1:b13").Value
         ws1.Range("c1:c13").Offset(lngrow, 0).Value = ws.Range("c1:c13").Value
         ws1.Range("A14:A231").Offset(lngrow, 0).Value = ws.Range("A16:A233").Value
         ws1.Range("B14:B231").Offset(lngrow, 0).Value = ws.Range("C16:C233").Value
         ws1.Range("E14:E231").Offset(lngrow, 0).Value = ws.Range("H16:H233").Value
         ws1.Range("D14:D231").Offset(lngrow, 0).Value = ws.Range("d16:d233").Value
         ws1.Range("F14:F231").Offset(lngrow, 0).Value = ws.Range("F16:F233").Value
         ws1.Range("A232:A277").Offset(lngrow, 0).Value = ws.Range("I16:I61").Value
         ws1.Range("b232:b277").Offset(lngrow, 0).Value = ws.Range("J16:J61").Value
         ws1.Range("d232:d277").Offset(lngrow, 0).Value = ws.Range("K16:K61").Value
         ws1.Range("e232:e277").Offset(lngrow, 0).Value = ws.Range("l16:l61").Value
         
        lngrow = lngrow + 278
        End If
        Wb.Close False
                     End With
    Next i

 

[Kenneth Hobson]

Remove the = sign?

If copying values and formats, a Copy should suffice. If not, see comment lines.

Sub Test()
  Dim ws1 As Worksheet, ws2 As Worksheet
  
  Set ws1 = Worksheets("Sheet1")
  Set ws2 = Worksheets("Sheet2")
  
  ws1.Range("A1:A13").Copy ws2.Range("A1:A13")
  'ws1.Range("A1:A13").Copy
  'ws2.Range("A1:A13").PasteSpecial xlPasteFormats
  'ws2.Range("A1:A13").PasteSpecial xlPasteValues
  
  Application.CutCopyMode = False
End Sub

 

[Tmini]

Remove the = sign?

If copying values and formats, a Copy should suffice. If not, see comment lines.

Sub Test()
  Dim ws1 As Worksheet, ws2 As Worksheet
  
  Set ws1 = Worksheets("Sheet1")
  Set ws2 = Worksheets("Sheet2")
  
  ws1.Range("A1:A13").Copy ws2.Range("A1:A13")
  'ws1.Range("A1:A13").Copy
  'ws2.Range("A1:A13").PasteSpecial xlPasteFormats
  'ws2.Range("A1:A13").PasteSpecial xlPasteValues
  
  Application.CutCopyMode = False
End Sub

Thanks for your reply Kenneth
I tried your suggestions but I am clearly doing something wrong as it just won't work. I removed the = sign etc and it wouldn't work. It just kept coming up with errors such as "copy method of range class failed" etc. I am a noob at this and so I am not entirely sure what I am doing wrong. The reason why I didn't use copy in the first place was that I didn't want to copy any formulas I just wanted the values. The current code does this but I would like the formatting to come with it too. I have included the entire code below as there is a bit more to it if that would make any more sense. It's basically looping through a bunch of spreadsheets and copying that info into a new workbook.

Sub CommandButton1_Click()    Dim x, fldr As FileDialog, SelFold As String, i As Long
    Dim ws As Worksheet, ws1 As Worksheet
    Dim Wb As Workbook, Filename As String


       Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        If .Show <> -1 Then GoTo Cleanup
        SelFold = .SelectedItems(1)
    End With


    'All .xls* files in Selected FolderPath including Sub folders are put into an array
    x = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & SelFold & "\*.xls"" /s/b").stdout.readall, vbCrLf)
     
     Set ws1 = ThisWorkbook.Sheets("sheet2")
          
    'Loop through that array
    For i = LBound(x) To UBound(x) - 1


    'Open (in background) the Workbook
        With GetObject(x(i))
           
            ThisWorkbook.Sheets(1).UsedRange
            Filename = Split(x(i), "\")(UBound(Split(x(i), "\")))
       Set Wb = Workbooks(Filename)
        Set ws = Nothing
        On Error Resume Next
        'change sheet name here
        Set ws = Wb.Sheets("Sheet 5")
        On Error GoTo 0
        If Not ws Is Nothing Then
         ws1.Range("A1:A13").Offset(lngrow, 0).Value = ws.Range("A1:A13").Value
         ws1.Range("b1:b13").Offset(lngrow, 0).Value = ws.Range("b1:b13").Value
         ws1.Range("c1:c13").Offset(lngrow, 0).Value = ws.Range("c1:c13").Value
         ws1.Range("A14:A231").Offset(lngrow, 0).Value = ws.Range("A16:A233").Value
         ws1.Range("B14:B231").Offset(lngrow, 0).Value = ws.Range("C16:C233").Value
         ws1.Range("E14:E231").Offset(lngrow, 0).Value = ws.Range("H16:H233").Value
         ws1.Range("D14:D231").Offset(lngrow, 0).Value = ws.Range("d16:d233").Value
         ws1.Range("F14:F231").Offset(lngrow, 0).Value = ws.Range("F16:F233").Value
         ws1.Range("A232:A277").Offset(lngrow, 0).Value = ws.Range("I16:I61").Value
         ws1.Range("b232:b277").Offset(lngrow, 0).Value = ws.Range("J16:J61").Value
         ws1.Range("d232:d277").Offset(lngrow, 0).Value = ws.Range("K16:K61").Value
         ws1.Range("e232:e277").Offset(lngrow, 0).Value = ws.Range("l16:l61").Value
         
        lngrow = lngrow + 278
        End If
        Wb.Close False
                     End With
    Next i


Cleanup:
    Set fldr = Nothing
End Sub

 

[Kenneth Hobson]

I don't see where you did a copy paste. Applying what I showed you to your code for the first data range, notice how I condensed it:

  'ws1.Range("A1:A13").Offset(lngrow, 0).Value = ws.Range("A1:A13").Value
  'ws1.Range("b1:b13").Offset(lngrow, 0).Value = ws.Range("b1:b13").Value
  'ws1.Range("c1:c13").Offset(lngrow, 0).Value = ws.Range("c1:c13").Value
  ws.Range("A1:C13").Copy
  ws1.Range("A1:C13").Offset(lngrow).PasteSpecial xlPasteFormats
  ws1.Range("A1:C13").Offset(lngrow).PasteSpecial xlPasteValues

When doing this sort of thing, don't forget to turn off screenupdating, calculation, and event and then back on. It will help speed a little.

 

[Tmini]

Thanks heaps Kenneth it worked now