lundi 20 avril 2015

Loop does not recognize Do

I have been editing/writing this code to merge multiple workbooks into one. However I get a "Loop without Do" compile error. The possible duplicate does not say what went wrong, only gives a new code, so that is not a answer to my question but a solution.

Sub MergeAllWorkbooks()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim OCol As Long
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim SourceRangeCult As Range
    Dim DestRangeCult As Range
    Dim SourceRangeYield As Range
    Dim DestRangeYield As Range
    Dim SourceRangeLoc As Range
    Dim DestRangeLoc As Range
    Dim SourceRangeDRipe As Range
    Dim DestRangeDRipe As Range
    Dim LastRow As Integer
    Dim LastColumn As Integer
    Dim col As Integer

    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

    FolderPath = "M:\My Documents\MSC Thesis\United Kingdom\Winter Barley\Merge excel\"

    NRow = 1
    OCol = 2
    OColD = OCol + 48


    FileName = Dir(FolderPath & "*.xl*")


        Do While FileName <> ""

            Set WorkBk = Workbooks.Open(FolderPath & FileName)


            SummarySheet.Range("A" & NRow).Value = FileName


            LastRow = ActiveSheet.UsedRange.Rows.Count
            LastColumn = ActiveSheet.UsedRange.Columns.Count

                For col = 2 To 49

                Set SourceRangeLoc = WorkBk.Worksheets(1).Range("A1:A" & LastRow)
                Set DestRangeLoc = SummarySheet.Range("C" & NRow)
                Set DestRangeLoc = DestRange.Resize(SourceRangeLoc.Rows.Count, 1)

                Set SourceRangeCult = WorkBk.Worksheets(1).Range(OCol & "1:" & OCol & "1")
                Set DestRangeCult = SummarySheet.Range("B" & NRow)
                Set DestRangeCult = DestRange.Resize(SourceRangeLoc.Rows.Count, 1)

                Set SourceRangeYield = WorkBk.Worksheets(1).Range(OCol & "2:" & OCol & LastRow)
                Set DestRangeYield = SummarySheet.Range("D" & NRow)
                Set DestRangeYield = DestRange.Resize(SourceRangeLoc.Rows.Count, 1)

                Set SourceRangeDRipe = WorkBk.Worksheets(1).Range(OColD & "2:" & OColD & LastRow)
                Set DestRangeDRipe = SummarySheet.Range("E" & NRow)
                Set DestRangeDRipe = DestRange.Resize(SourceRangeLoc.Rows.Count, 1)


                DestRangeCult.Value = SourceRangeCult.Value

                Exit For

                NRow = NRow + DestRange.Rows.Count
                OCol = OCol + 1

            WorkBk.Close savechanges:=False

            FileName = Dir()

        Loop

    SummarySheet.Columns.AutoFit

End Sub

Aucun commentaire:

Enregistrer un commentaire