Adding additional information to every nth row from start reference, copying same instance of rows

rossross

New Member
Joined
Apr 11, 2022
Messages
39
Office Version
  1. 365
Platform
  1. Windows
I've got code here that will bring in information while looping through workbooks in a folder. It could be 5 workbooks or 50. Usually on the higher end. I'm bringing in 5 rows of information so every time i open a new workbook for information, i need it to go down to the 5th row and start again with same information. Then I need to copy the format from the first instance down to the last. I've got it current where it just puts the information over each other and formats the first instance.

Please excuse my text below as some of it needs to be withheld


VBA Code:
Sub loopwb()

'Dim count 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("B10")


Do Until Len(fn) = 0
    'Debug.Print fn
    Set nwb = Workbooks.Open("C:\Users\User\Desktop\Folder\" & fn)
    Set nws = nwb.Worksheets("Sheet1")
    
    ws.Range("B10").Value2 = nws.Range("A4").Value2
    'change b10 to sc to initiate variable sequence
    ws.Range("C10").Value2 = nws.Range("J6").Value2
    ws.Range("H10").Value2 = nws.Range("P17").Value2
    ws.Range("I10").Value2 = nws.Range("S17").Value2
    ws.Range("J10").Value2 = "- text " & (nws.Range("E13").Value2 * 100) & " text"
    ws.Range("K10").Value2 = nws.Range("S18").Value2
    ws.Range("L10").Value2 = ", WAL"
    ws.Range("M10").Value2 = nws.Range("L13").Value2
    ws.Range("B11").Value2 = Chr(149) & " " & "text:"
    ws.Range("C11").Value2 = nws.Range("C16").Value2
    ws.Range("H11").Value2 = Chr(149) & " " & "text:"
    ws.Range("I11").Value2 = nws.Range("H36").Value2
    ws.Range("B12").Value2 = Chr(149) & " " & "text:"
    ws.Range("C12").Value2 = nws.Range("C20").Value2
    ws.Range("B13").Value2 = Chr(149) & " " & "text:"
    ws.Range("C13").Value2 = nws.Range("C14").Value2
    
        If nws.Range("S10") = "text" Then
            ws.Range("B14").Value2 = Chr(149) & " " & "text"
        Else
            ws.Range("B14").Value2 = Chr(149) & " " & "text"
        End If
       
    ws.Range("B15").Value2 = Chr(149) & " " & "text: " & nws.Range("S9").Value2
    ws.Range("H12").Value2 = Chr(149) & " " & "text:"
    ws.Range("I12").Value2 = nws.Range("S19").Value2
    ws.Range("H13").Value2 = Chr(149) & " " & "text:"
    ws.Range("I13").Value2 = nws.Range("H34").Value2
    
    
    ws.Range("H14").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 lr As Long

Set ws = ThisWorkbook.Worksheets("List")
With ws
    Columns("B:M").EntireColumn.AutoFit
    .Range("B10:M10").Font.Bold = True
    .Range("B10:M10").Interior.Color = RGB(0, 48, 87)
    .Range("B10:M10").Font.Color = RGB(255, 255, 255)
    .Range("B15").Font.Bold = True
    .Range("B14").Font.Bold = True
    .Range("C11").NumberFormat = "#.000%"
    .Range("C11").HorizontalAlignment = xlLeft
    .Range("C15").Font.Bold = True
    .Range("C15").HorizontalAlignment = xlLeft
    .Range("K10").NumberFormat = "#.000%"
    .Range("M10").NumberFormat = "General"
    .Range("I11").NumberFormat = "#"
    .Range("I11").HorizontalAlignment = xlLeft
    .Range("I12").NumberFormat = "#.000%"
    .Range("I13").NumberFormat = "$#,#"
    .Range("I13").HorizontalAlignment = xlLeft
    Columns("D:E").ColumnWidth = 4
    
    Set cr = .Range("B10:M15")
    lr = .Range("B" & .Rows.count).End(xlUp).Row
    

End With


End Sub
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Forum statistics

Threads
1,223,880
Messages
6,175,154
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top