Incement column in VBA

[wilest]

Hi
I desperately need help. I want my macro to:
select A1:C68 and cut it and paste it on another place and the
select D1:F68 and cut it and paste it on another place etc etc
Please help!

    Dim i As Integer
    var1col = 1
    var2col = 3
    var3 = 1
    For i = 1 To 100
    Windows("Book2").Activate
    Range(var1col & "1" & ":" & "68" & var2col).Select
    Selection.Cut
    Windows("results.xlsx").Activate
    Range("E" & var3).Select
    ActiveSheet.Paste
    var1col = var1col + 3
    var2col = var2col + 3
    var3 = var3 + 68
    Next i

 

[RSXchin]

Use Cells() instead of range()

 

[lenze]

Hi and welcome to the board!!!
This is untested, but shouuld be close

Sub CopyMe()
Dim WB1 As Workbook
Dim WB2 As Workbook
Set WB1 = Windows("Book2")
Set WB2 = Windows("results.xlsx")
Dim LR As Long
Dim LC As Long
Dim i As Long
LC = WB1.Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LC Step 3
WB1.Sheets("Sheet1").Cells(1, i).Resize(68, 3).Copy
LR = WB2.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
WB2.Sheets("Sheet1").Cells(LR + 1, "A").Paste
Next i
End Sub

lenze

 

[wilest]

Thank you but it is complaining it gives a run time error, type mismatch and if i click debug it complains about

Set WB1 = Windows("Book2")

 

[lenze]

Try

Set WB1 = Windows("Book2.xlsm")

lenze

 

[wilest]

sorry but it still doesn't work.

 

[lenze]

OK, then try this

Sub CopyMe()
Dim LR As Long
Dim LC As Long
Dim i As Long
LC = Windows("Book2").Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LC Step 3
Windows("Book2").Sheets("Sheet1").Cells(1, i).Resize(68, 3).Copy
LR = Windows("results.xlsx").Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Windows("results.xlsx").Sheets("Sheet1").Cells(LR + 1, "A").Paste
Next i
End Sub

lenze

 

[RSXchin]

You know his code will only work if you have a Book2, right? Book1 won't work, neither will anyhing other than Book2.

 

[wilest]

Hi All
I understand that I must have a book2 active or open for the macro to work, but it still gives me errors on the following code:

LC = Windows("Book2").Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column

Any other ideas? Thanks for the great forum!

 

[Norie]

If I understand correctly you could try this - change worksheet/workbook names as needed.

Option Explicit
 
Sub MoveData()
Dim wbSrc As Workbook
Dim wbDst As Workbook
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Dim rngSrc As Range
Dim rngDst As Range

    Set wbSrc = ThisWorkbook
    
    Set wsSrc = wbSrc.Worksheets("Sheet1")
    
    
    Set rngSrc = wsSrc.Range("A1:C68")
    
    Set wbDst = Workbooks("OtherWorkbook.xls")
    
    Set wsDst = wbDst.Worksheets("Sheet2")
    Set rngDst = wsDst.Range("E1")
        
    While rngSrc.Cells(1, 1).Value <> ""
    
        rngSrc.Copy rngDst
        
        rngSrc.Clear
        
        Set rngSrc = rngSrc.Offset(, 3)
        
        Set rngDst = rngDst.Offset(68)
        
    Wend
    
End Sub