Copy multiple files in a folder and lines into one masterfile

0
votes

I am new at creating macros. Only created 5 of them for specific problems.

Could someone help me amend the below macro? I found it on the internet, I amended it to my preferences. But still there is room from improvement. Anyways it works perfectly except for the below.

There would be a lot of files in folder. Each file contains a tab named "PIVOT", where the format are the same, but the amount of data are different.

The range is in the PIVOT tab are from A to AM columns. They start at row 15. And I would only need those lines where the "closed" indication is not written (Status column is in AJ column). I want all of these rows to be copied into a master file under each other. The amount of rows varies greatly - like 0 to 200 depending on the open items.

Secondly, can someone tell me a book, that could be purchased so that I could evolve my knowledge? Thank For your help!

Tibor

Sub Import_to_Master() Dim sFolder As String Dim sFile As String Dim wbD As Workbook, wbS As Workbook

Application.ScreenUpdating = False
Set wbS = ThisWorkbook
sFolder = wbS.Path & "\"

sFile = Dir(sFolder)
Do While sFile <> ""

    If sFile <> wbS.Name Then
        Set wbD = Workbooks.Open(sFolder & sFile) 'open the file; add condition to

         ' >>>>>> Adapt this part
        wbD.Sheets("PIVOT").Range("A15:AM26").Copy
        wbS.Activate
        Sheets("Template").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
         ' >>>>>>
        wbD.Close savechanges:=True 'close without saving
    End If

    sFile = Dir 'next file
Loop
Application.ScreenUpdating = True

End Sub

2
excelvbacopy
Wouldn't worry about a book when you have StackOverflow and the rest of the internet. You have already found the last row in your master with Range("A" & Rows.Count).End(xlUp) so you can just modify your Range("A15:AM26") using the above code to find the last row in your individual files. – Tim Wilkinson
Ok, but there are lines, which are not needed. I only need those where the status is not closed. There is a specific column with 9-10 option. One of them is "closed", but that is what I don't care. Plus if I add Range("A" & Rows.Count).End(xlUp), it says out of range. I assume it is because the source file starts from row 14. Thanks for the booking advice :) but I would look for something that teaches me something day by day if I spend 15-30 mins per day. – T.Grof

2 Answers

1
votes

you may be after this:

        ' >>>>>> Adapted part
        With wbD.Sheets("PIVOT")
            With .Range("AM14", .Cells(.Rows.count, 1).End(xlUp)) '<--| reference its column "A:AM" range from row 14 down to column "A" last not empty row
                .AutoFilter Field:=36, Criteria1:="<>closed" '<--| filter referenced range on its 36th column (i.e. column "AJ") with values different from "closed"
                If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then
                    .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy
                    Sheets("Template").Range("A" & Rows.count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    Application.CutCopyMode = False
                End If
            End With
            .AutoFilterMode = False
        End With
        ' >>>>>>
0
votes

If you need to check each row for a certain cell value use something like the following. This will loop through line by line checking for lines that don't say "Closed".

Dim sFolder As String, sFile As String, wbD As Workbook, wbS As Workbook
Dim lastRowS As Integer, lastRowD As Integer
Application.ScreenUpdating = False
Set wbS = ThisWorkbook
sFolder = wbS.Path & "\"
sFile = Dir(sFolder

lastRowS = Sheets("Template").Range("A" & Rows.Count).End(xlUp).Row + 1

Do While sFile <> ""

If sFile <> wbS.Name Then
    Set wbD = Workbooks.Open(sFolder & sFile) 'open the file; add condition to

    lastRowD = wbD.Sheets("PIVOT").Range("A" & Rows.Count).End(xlUp).Row

    For i = 15 To lastRowD
        If Cells(i, 3) <> "Closed" Then 'change 3 to whatever column number has Closed in
            wbD.Sheets("PIVOT").Rows(i).EntireRow.Copy
            wbS.Sheets("Template").Cells(lastRowS, 1).PasteSpecial xlPasteValues
            lastRowS = lastRowS + 1
        End If
    Next i
    Application.CutCopyMode = False
     ' >>>>>>
    wbD.Close savechanges:=False 'close without saving
End If

sFile = Dir 'next file
Loop
Application.ScreenUpdating = True
End Sub