Macro Code Help - I am copying lots of workbooks into 1 main workbook but have 12 lines on each individual workbook that don't need copying

0

Hi,

I am currently taking 40 workbooks (timesheets) and pulling all the information into 1 master. This is working however I need the first 12 lines of each workbook not to be pulled across (they are just instructions to the user and an electronic signature).

It would save me so much time instead of deleting 40 of these every time the data gets pulled across.

The current wording I am using is:

'Summary:    Merge files in a specific folder into one master sheet (stacked)
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet
'Setup
    Application.ScreenUpdating = False  'speed up macro execution
    Application.EnableEvents = False    'turn off other macros for now
    Application.DisplayAlerts = False   'turn off system messages for now
 Set wsMaster = ThisWorkbook.Sheets("ImportDataSheet")    'sheet report is built into
With wsMaster
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        Cells.Select
        Selection.UnMerge
        .UsedRange.Offset(1).EntireRow.Clear
        NR = 2
    Else
        NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data
    End If
'Path and filename (edit this section to suit)
    fPath = "X:\Project Management\Project Management\PROJECTS\05. OPS REPORTS & PROCUREMENT FORECAST\2018\0001 - Design Resource Allocation\Trial Timesheets/"   'remember final \ in this string
 On Error Resume Next
 MkDir fPathDone                 'creates the completed folder if missing
 On Error GoTo 0
  fName = Dir(fPath & "*.xlsx*")        'listing of desired files, edit filter as desired
'Import a sheet from found files
 Do While Len(fName) > 0
 If fName <> ThisWorkbook.Name Then              'don't reopen this file accidentally
 Set wbData = Workbooks.Open(fPath & fName)  'Open file
        'This is the section to customize, replace with your own action code as needed
            LR = Range("A" & Rows.Count).End(xlUp).Row  'Find last row
            Range("A2:A" & LR).EntireRow.Copy .Range("A" & NR)
            wbData.Close False                                'close file
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1  'Next row
            fName = Dir                                       'ready next filename
        End If
    Loop
End With
ErrorExit:    'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen

If you can help it would be amazing - I am not an excel expert just a determined excel user!

Thank you

Answer
Discuss

Discussion

Please put CODE tags around your code. To do that, edit your post, select your code and click the CODE button. (Done for you this time, but please remember to do this in the future.)
don (rep: 1492) Jul 31, '18 at 1:16 pm
Add to Discussion

Answers

0
Selected Answer

Just a quick shot before I knock off for the day. Please look for this line in your code.

Range("A2:A" & LR).EntireRow.Copy .Range("A" & NR)

It specifies that a range from A2:A & LR should be copied, where LR is a variable specifying the last row. So, the range being transferred might be something line A2:A100. Now, if you don't wnat the first 12 lines, don't start at A2. Start at A14. So, by amending this instruction the problem might be solved. If not, please tell me what you get with this amended line and I shall look at it tomorrow.

Range("A14:A" & LR).EntireRow.Copy .Range("A" & NR)
Discuss

Discussion

Thank you thank you, worked straight away - appreciate your help!!
Blakieb (rep: 2) Jul 31, '18 at 8:06 am
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login