Excel do while the sheet is not blank

Question

I have a problem with my macro:

' t Makro
'
' Keyboard Shortcut: Ctrl+t
'
    Selection.End(xlDown).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("List3").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("Hárok2").Select
    Application.CutCopyMode = False
    Selection.ClearContents

End Sub

And I would like it to continue till the sheet is totally empty, please, where should I insert code and how should it look like?

Thank you very much for a help

What are you trying to do? Copy data from Hárok2 worksheet to the List3 worksheet? — BruceWayne

Tony M Tony M · Accepted Answer · 2018-03-29T21:11:24

The short answer is you need to replace all "selection"s with range variables, and also use variables for other objects. The "selection" and ".select" added by the macro recorder will cause problems otherwise.

For example, below is some code that will do what your code does, assuming that the initially selected cell on each sheet is A1 and that the there are blank rows at the top of the Hárok2 but not at the top of the List3 sheet. I had do make these assumptions because you did not supply what your data looks like.

Perhaps this code will provide a starting point. Once you apply it to your situation, you can add a loop so that it will clear the sheet, as you said. Feel free to ask questions.

I added ".select" statements to the code so that you could step through it and see how it works, but those can be deleted (and should be) once you understand how things work.

Option Explicit
Dim sh1 As Worksheet, sh2 As Worksheet
Dim r1 As Range, r2 As Range
Sub transferTest()

Set sh2 = Worksheets("Hárok2")
Set r2 = sh2.Range("A1").End(xlDown)
r2.Select
Set r2 = sh2.Range(r2, r2.End(xlDown))
r2.Select
r2.copy
Set sh1 = Worksheets("List3")
sh1.Activate
Set r1 = sh1.Range("A1").End(xlDown).Offset(1, 0)
r1.Select
r1.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
sh2.Select
r2.ClearContents
End Sub

Excel do while the sheet is not blank

1 Answers