Excel VBA-使用数组在工作表中移动，然后复制粘贴第n行

Question

I am a little new to VBA, I just started using it in excel recently and have reached a road block.

I am creating a crosswalk in order to upload my data to a business intelligence application. Unfortunately I do not have a connection to the database to run my reports so I have to do this with excel. The issue that I am running into is that there is a bug in our application where after the 1000th row in an excel document it will skip every 1000th line. Our development team is aware of this but there is no ETA to resolve the issue. As a work around I am trying to use VBA to copy the 1000th line (starting with 2000) to the end of the same sheet.

I currently have code wrote for this that works on a single worksheet, but I have several pages that have over 1000 rows, so I am trying to feed the names of those sheets into an array and cycle through each one and do the copy/pasting.

My working code for 1 worksheet:

Sub Test()

Dim WB As Workbook
Dim WS As Worksheet
Dim i As Integer
Dim x As Integer
Dim r As Range



Set WB = Workbooks("macrotesting.xlsm")
Set WS = Worksheets("Usage")

Set r = WS.UsedRange
k = r.Rows.Count
x = 2000
i = 2

Do While x < k

WS.Range(("A" & x) & (":L" & x)).Copy
WS.Rows.End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

i = i + 1
x = 1000 * i

Loop

End Sub

I was able to find some help with this here but it is failing. Code with the Array:

Sub Test()

Dim wsArray As Variant
Dim wsArrayCrnt As Variant
Dim i As Integer
Dim x As Integer
Dim r As Range

wsArray = Array("Usage", "Use")

For Each wsArrayCrnt In wsArray
With Worksheets(wsArrayCrnt)

    r = .UsedRange
    k = r.Rows.Count
    x = 2000
    i = 2

    Do While x < k

    .Range(("A" & x) & (":L" & x)).Copy
    .End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

    i = i + 1
    x = 1000 * i

    Loop
End With
Next wsArrayCrnt

End Sub

It seems to be failing at the

 k = r.Rows.Count

Though I am not sure if it will finish after this.

I have also tried to dimension the workbook and add it to the with statement and all the variables after.

Answer 1

Instead of manually typing in which sheets you want could you not just cycle through all the work sheets in the workbook?

Sub test()
Dim i As Integer
Dim x As Integer
Dim r As Range

For Each wsheet In ActiveWorkbook.worksheets

    Set r = wsheet.UsedRange
    k = r.Rows.Count
    x = 2000
    i = 2

    Do While x < k
        wsheet.Range(("A" & x) & (":L" & x)).Copy
        wsheet.Rows.End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

        i = i + 1
        x = 1000 * i
    Loop

Next wsheet

End Sub

This will cycle through each worksheet in the current workbook you are running the macro from and copy every 1000th row to the end of worksheet.

(Any sheet with less than 2000 rows will skip over the do while loop and be ignored)

Answer 2

you must type

Set r = .UsedRange

Since UsedRange is an object (namely a Range object)

You may also want to use a more compact code like follows:

Sub Test()

Dim wsArrayCrnt As Variant
Dim x As Long

For Each wsArrayCrnt In Array("Usage", "Use")
    With Worksheets(wsArrayCrnt)
        x = 2000
        Do While x < .UsedRange.Rows.Count
           .Range(("A" & x) & (":L" & x)).Copy
           .End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
           x = x + 1000
       Loop
    End With
Next wsArrayCrnt

End Sub