Paste Range to next available sheet

Please see the attached file.

I need a macro that will copy range A1:C1 of sheet 3 and paste it to A1 of the next available sheet.

On the attached file, you will notice that sheet 1 has something in Cell A1:C1, so in this case I would need it to paste A1:C1 of sheet 3 to Cell A1:C1 of sheet 2 (Since it is the next available sheet without data in that range)

It has to work for as many sheets as are in the workbook.

Thanks

I might be able to give this a go...

Is there going to be some type of order that the sheets are in?

Are there going to be any sheets that should be excluded (outside of a sheet that alreay has numbers)?

Are you going to run this macro from the activesheet with data you want moved?

Will you ever run out of sheets tabs or is it possible every tab is filled but not more tabs in the workbook?

does this only need to work from sheet3, or would you like to copy from any active sheet?

Maybe this could be a start...

Run from the activesheet

Sub movedata()
    Dim ws As Worksheet
    Application.ScreenUpdating = False
    With ActiveSheet
        .Range("A1:C1").Copy
        For Each ws In ActiveWorkbook.Worksheets
            If Len(ws.Range("A1")) = 0 Then
                ws.Range("A1").PasteSpecial xlPasteValues
            End If
        Next ws
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

works from the active sheet i think:

Option Explicit

Sub moveRangeToVacant()

Dim placeFound As Boolean
Dim i As Integer, j As Integer


placeFound = False
i = ActiveSheet.Index
If i + 1 > ThisWorkbook.Worksheets.Count Then
    j = 1
Else
    j = i + 1
End If

Do
    If _
        ThisWorkbook.Worksheets(j).Cells(1, 1).Value = "" And _
        ThisWorkbook.Worksheets(j).Cells(1, 2).Value = "" And _
        ThisWorkbook.Worksheets(j).Cells(1, 3).Value = "" _
        Then
         placeFound = True
    Else
        If j + 1 > ThisWorkbook.Worksheets.Count Then
            j = 1
        Else
            j = j + 1
        End If ' j + 1 > ThisWorkbook.Worksheets.Count
    End If

Loop While Not placeFound And j <> i

'align values'
If placeFound Then
    ThisWorkbook.Worksheets(j).Range("A1:C1").Value = ThisWorkbook.Worksheets(i).Range("A1:C1").Value
    'no blank was found'
Else
    MsgBox ("no open slot")
End If

End Sub

What does and what did you do?

With the worksheet you posted and the code from post #4, Sheet3 is active >> alt + F8 >> run movedata >> A1:C1 from sheet3 is moved over to sheet2 because it is empty in A1.

It doesn't paste it to the activesheet, it just copies it, but you want it completely cut?

Sub movedata()
    Dim ws As Worksheet
    Application.ScreenUpdating = False
    With ActiveSheet
        For Each ws In ActiveWorkbook.Worksheets
            If Len(ws.Range("A1")) = 0 Then
                .Range("A1:C1").Cut ws.Range("A1")
            End If
        Next ws
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Give this a try

Sub movedata()
    Dim ws As Worksheet
    Dim i As Long: i = 0
    Dim rng As Range
    Set rng = ActiveSheet.Range("A1:C1")
    Application.ScreenUpdating = False
        For Each ws In ActiveWorkbook.Worksheets
            If i = 1 Then GoTo ExitOut
            If Len(ws.Range("A1")) = 0 Then
                rng.Cut ws.Range("A1")
                With ws.Range("A1").Offset(0, 3)
                    .Value = .Value
                End With
                i = 1
            End If
        Next ws
ExitOut:
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

jbmerrel,

One way...

Sub tgr()
    
    Dim wsSrc As Worksheet
    Dim wsDest As Worksheet
    Dim wsIndex As Long
    
    Set wsSrc = ActiveSheet
    wsIndex = wsSrc.Index + 1
    If wsIndex > ActiveWorkbook.Sheets.Count Then wsIndex = 1
    
    Do While wsIndex <> wsSrc.Index
        If WorksheetFunction.CountA(Sheets(wsIndex).Range("A1:C1")) = 0 Then
            Set wsDest = Sheets(wsIndex)
            Exit Do
        End If
        Select Case wsIndex
            Case ActiveWorkbook.Sheets.Count: wsIndex = 1
            Case Else:                        wsIndex = wsIndex + 1
        End Select
    Loop
    
    If wsDest Is Nothing Then
        MsgBox "No worksheet contains an empty A1:C1 range. Exiting macro"
        Exit Sub
    End If
    
    wsDest.Range("A1:C1").Value = wsSrc.Range("A1:C1").Value
    MsgBox "Put values in: " & wsDest.Name

    'Uncomment this line if you want to remove the values from the source sheet
    'wsSrc.Range("A1:C1").ClearContents
    
End Sub

Updated code. It still places the values in A1 of the destination worksheet, but it places the values into the same size range as the selected range from the source worksheet. So if the selected range was C5:E6 (2 rows and 3 columns), the values will be placed in the destination worksheet A1:C2

Sub tgr()
    
    Dim rngSrc As Range
    Dim wsDest As Worksheet
    Dim wsIndex As Long
    
    On Error Resume Next
    Set rngSrc = Application.InputBox("Select the range to copy to a next available sheet", "Move Values", Selection.Address, Type:=8)
    On Error GoTo 0
    
    If rngSrc Is Nothing Then Exit Sub  'User pressed cancel
    
    wsIndex = rngSrc.Parent.Index + 1
    If wsIndex > ActiveWorkbook.Sheets.Count Then wsIndex = 1
    
    Do While wsIndex <> rngSrc.Parent.Index
        If WorksheetFunction.CountA(Sheets(wsIndex).Range("A1").Resize(rngSrc.Rows.Count, rngSrc.Columns.Count)) = 0 Then
            Set wsDest = Sheets(wsIndex)
            Exit Do
        End If
        wsIndex = wsIndex + 1
        If wsIndex > ActiveWorkbook.Sheets.Count Then wsIndex = 1
    Loop
    
    If wsDest Is Nothing Then
        MsgBox "No worksheet contains an empty " & Range("A1").Resize(rngSrc.Rows.Count, rngSrc.Columns.Count).Address(0, 0) & " range. Exiting macro"
        Exit Sub
    End If
    
    wsDest.Range("A1").Resize(rngSrc.Rows.Count, rngSrc.Columns.Count).Value = rngSrc.Value
    MsgBox "Values have been placed in: " & wsDest.Name
    
    'Uncomment this line if you want to remove the values from the source sheet
    'rngSrc.ClearContents
    
End Sub