Starting at a new row for every file opened, formatting every nth row

Viewed 18

I'm looping through a folder and grabbing data points. The code below works, but I don't know how to get it to add the new data for each workbook below. It currently just pastes over each other. I tried to use i as an integer and count the number of folders and command to add 5 rows for each folder but my loop cancels out the next loop somehow. not to mention i don't know how to make it add for the next workbook. So I just need it to open the workbook, grab this data, close the workbook, open the next one, grab the same information and just put that right below what the previous workbook did.

My formatting simply needs to grab the copy range and copy the exact same range down to the last row.

Sub loopwb()

'Dim fc As Integer
'Dim sc As Range

fn = dir("C:\Users\user\Desktop\folder\*xlsx")


    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

Set wb = ThisWorkbook
Set ws = wb.Worksheets("List")

'Set sc = ws.Range("B11")


Do Until Len(fn) = 0
    'Debug.Print fn
    Set nwb = Workbooks.Open("C:\Users\user\Desktop\folder\" & fn)
    Set nws = nwb.Worksheets("sht1")
    
    ws.Range("B10").Value2 = "text"
    ws.Range("B11").Value2 = nws.Range("A4").Value2
    'change b11 to sc to initiate variable sequence
    ws.Range("C11").Value2 = nws.Range("J6").Value2
    ws.Range("H11").Value2 = nws.Range("P17").Value2
    ws.Range("I11").Value2 = nws.Range("S17").Value2
    ws.Range("K11").Value2 = nws.Range("S18").Value2
    ws.Range("L11").Value2 = ", WAL"
    ws.Range("M11").Value2 = nws.Range("L13").Value2
    ws.Range("B12").Value2 = Chr(149) & " " & "text"
    ws.Range("J11").Value2 = "text " & (nws.Range("E13").Value2 * 100) & " text:"
    ws.Range("C12").Value2 = nws.Range("C16").Value2
    ws.Range("H14").Value2 = Chr(149) & " " & "text:"
    ws.Range("I14").Value2 = nws.Range("H36").Value2
    ws.Range("B13").Value2 = Chr(149) & " " & "text:"
    ws.Range("C13").Value2 = nws.Range("C20").Value2
    ws.Range("B14").Value2 = Chr(149) & " " & "text:"
    ws.Range("C14").Value2 = nws.Range("C14").Value2
    ws.Range("H13").Value2 = Chr(149) & " " & "text:"
    ws.Range("I13").Value2 = nws.Range("C17").Value2
    
        If nws.Range("S10") = "text" Then
            ws.Range("B15").Value2 = Chr(149) & " " & "text"
        Else
            ws.Range("B15").Value2 = Chr(149) & " " & "text"
        End If
       
    ws.Range("B16").Value2 = Chr(149) & " " & "text: " & nws.Range("S9").Value2
    ws.Range("H16").Value2 = Chr(149) & " " & "text:"
    ws.Range("I16").Value2 = nws.Range("S19").Value2
    ws.Range("H15").Value2 = Chr(149) & " " & "text:"
    ws.Range("I15").Value2 = nws.Range("H34").Value2
    
    
    ws.Range("H12").Value2 = Chr(149) & " " & "text " & nws.Range("S11").Value2
    
    nwb.Close savechanges:=False
    
    
    fn = dir
Loop

    Call format
    
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub


Sub format()

Dim cr As Range
Dim hr As Range
Dim lr As Long
Dim i As Integer

Set ws = ThisWorkbook.Worksheets("List")
With ws
    Columns("B:M").EntireColumn.AutoFit
    .Range("B11:M11").Font.Bold = True
    .Range("B11:M11").Interior.Color = RGB(0, 48, 87)
    .Range("B11:M11").Font.Color = RGB(255, 255, 255)
    .Range("B16").Font.Bold = True
    .Range("B15").Font.Bold = True
    .Range("C12").NumberFormat = "#.000%"
    .Range("C12").HorizontalAlignment = xlLeft
    .Range("C16").Font.Bold = True
    .Range("C16").HorizontalAlignment = xlLeft
    .Range("K11").NumberFormat = "#.000%"
    .Range("M11").NumberFormat = "General"
    .Range("I14").NumberFormat = "#"
    .Range("I14").HorizontalAlignment = xlLeft
    .Range("I16").NumberFormat = "#.000%"
    .Range("I15").NumberFormat = "$#,#"
    .Range("I15").HorizontalAlignment = xlLeft
    .Range("I13").HorizontalAlignment = xlLeft
    .Range("I13").NumberFormat = "#0.000%"
    Columns("D:E").ColumnWidth = 4
    
    .Range("B10:M10").Font.Bold = True
    .Range("B10:M10").Interior.Color = RGB(91, 160, 220)
    .Range("B10:M10").Font.Color = RGB(255, 255, 255)
    
    
    Set cr = .Range("B11:M16")
    Set hr = .Range("B10:M10")
    lr = .Range("B" & .Rows.count).End(xlUp).Row
    
    'cr.Copy
    '    For i = 11 To lr Step 6
    '        PasteSpecial Paste:=xlPasteFormats
    '    Next i

End With


End Sub
0 Answers
Related