copy files code (improvement needed )

[arora]

Hello All,

I have been able to assemble a code to copy data from Sheet5 of different workbooks to a new workbook. I know the code is rudimentary but good for novice like me

I have to format the cells in the new workbook after copying the data for ex: make font bold. make left border thick, make both up and down border thick. It depends on the particular cell.

Can someone please tell me by what statement can I select the cell of the new workbook and then using With Selection change font/border etc.

I am not able to select the cells in the new workbook using Activecell command after I paste the data using statement
:: wSheet.Range("A1").Copy Destination:=ToSheet.Cells(r, c)


The full code goes like this: (I have kept it shorter for 5 cells only original is for 23 cells)

Sub Collate()
Dim ToSheet As Worksheet, wSheet As Worksheet
Dim ToBook As String, FromBook As String
Dim c As Integer, r As Integer
    
    Application.Calculation = xlCalculationManual
    ChDrive ActiveWorkbook.Path
    ChDir ActiveWorkbook.Path
    ToBook = ActiveWorkbook.Name
    Set ToSheet = ActiveSheet
    r = 8
    c = 4
    FromBook = Dir("*.xls")
    While FromBook <> ""
        If FromBook <> ToBook Then
            Application.StatusBar = FromBook
            Workbooks.Open Filename:=FromBook
                Set wSheet = Workbooks(FromBook).Worksheets("Sheet5")
                    With wSheet
                        wSheet.Range("A1").Copy Destination:=ToSheet.Cells(r, c)
                        r = r + 1
                        wSheet.Range("A2").Copy Destination:=ToSheet.Cells(r, c)
                        r = r + 1
                        wSheet.Range("A3").Copy Destination:=ToSheet.Cells(r, c)
                        r = r + 1
                        wSheet.Range("A4").Copy Destination:=ToSheet.Cells(r, c)
                        r = r + 1
                        wSheet.Range("A5").Copy Destination:=ToSheet.Cells(r, c)
                        r = r + 1
                    End With
                r = 8
                c = c + 1
                Set wSheet = Nothing
            Workbooks(FromBook).Close savechanges:=False
        End If
        FromBook = Dir
    Wend
    MsgBox ("Done.")
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic

End Sub

Thank you in advance
arora

[royUK]

Why copy individual cells?

If you use With wSheet then you don't need wSheet.Range, only .Range. Something like

 Set wSheet = Workbooks(FromBook).Worksheets("Sheet5")
                    With wSheet
                        .Range("A1:A5").Copy Destination:=ToSheet.Cells(r, c)                       
                    End With 
                c = c + 1

[arora]

Hello RoyUK

Thank you for your reply,

Your code is perfect ... basically I copied indiviual cells because the data to be copied on first cell has to be made Bold and then other cells have a color and also different cells have different border thicknesses.

I hav attached the file here and from column D onwards I enter the data.

Can you please suggest someway of selecting the cell to which data is copied and then changing its format. the number of columns in this file is 10 but they vary always.

I want to enter data in a cell, select it and then change its format ..

Thank you
arora