VBA: Loop with if condition only works correctly until the first TRUE

时间:2016-07-11 23:20:09

标签: excel vba loops if-statement

I am currently coding a loop in VBA and for some reason it only works until the first "If" statement is true. After that, it also applies the macro to cells that are FALSE. I just don't find the cause of this. In my example, operations 1.-3. should only be performed for x = 12 and x = 25 yet the code performes the macro for all x >= 12 and x <= 25

I've been trying for a good three hours now to fix this code and find an answer somewhere on the Internet... :-( Would be very happy if you could help! Thanks a lot in advance!

Sub CreateReport()

Dim lastrow As Long
Dim x As Long

lastrow = Sheets("Overview").Cells(Rows.Count, 1).End(xlUp).Row

For x = 10 To lastrow

    If ActiveSheet.Range("A" & x).EntireRow.Hidden = False Then

        '1. Copy sheet once per visible row

        Sheets("Master").Select
        Sheets("Master").Copy After:=Sheets(Sheets.Count)

        '2. Paste company name

        ActiveSheet.Cells(4, 1).Value = Sheets("Overview").Cells(x, 1).Value

        '3. Name worksheet after company name

        ActiveSheet.Name = Cells(4, 1).Value

    End If


Next x


End Sub

1 个答案:

答案 0 :(得分:0)

这是一个案例研究,说明为什么不应该使用“ActiveSheet”。问题是您将新创建的工作表设置为“ActiveSheet”,因此它开始检查新创建的工作表以查看是否有任何行被隐藏,而它们不是。指定变量:

Sub CreateReport()

Dim wb As Workbook
Dim overviewSheet As WorkSheet
Dim newSheet As Worksheet
Dim masterSheet As Worksheet
Dim lastrow As Long
Dim x As Long

Set wb = ThisWorkbook
Set overviewSheet = wb.Sheets("Overview")
Set masterSheet = wb.Sheets("Master")
lastrow = overviewSheet.Cells(overviewSheet.Rows.Count, 1).End(xlUp).Row

For x = 10 To lastrow

    If overviewSheet.Range("A" & x).EntireRow.Hidden = False Then

        '1. Copy sheet once per visible row


        masterSheet.Copy After:=wb.Sheets(wb.Sheets.Count)

        Set newSheet = wb.Sheets(wb.Sheets.Count)

        '2. Paste company name

        newSheet.Cells(4, 1).Value = overViewSheet.Cells(x, 1).Value

        '3. Name worksheet after company name

        newSheet.Name = Cells(4, 1).Value

    End If


Next x


End Sub