Find last column with data in a set of worksheets and paste it on the next column

[krapnek]

With a lot of help from Google and Mr. Excel I was able to draft a code that would detect the last column with data on a certain worksheet and paste it on the next column:

Sub CopyLastWeek()
'
' CopyLastWeek Macro
'
'Find the last used column in a Row: row 11 in this example
    Dim LastCol As Integer
    With ActiveSheet
        LastCol = .Cells(11, .Columns.Count).End(xlToLeft).Column
        'Shows confirmation with last input date'
    If MsgBox("Latest input date : " & Cells(10, LastCol) & "?", vbQuestion + vbYesNo) = vbNo Then
    Application.EnableEvents = True
    Exit Sub
    End If
        NextCol = LastCol + 1
        .Range(.Cells(11, LastCol), .Cells(60, LastCol)).Copy
        .Range(.Cells(11, NextCol), .Cells(60, NextCol)).Select
        ActiveSheet.Paste
    End With
End Sub

However, I would like to run this macro automatically in a certain range of sheets and not run it individually in each and every sheet. This is the code I came up so far:

Sub MAN_CopyLastWeek()

Dim ws As Worksheet
Dim LastCol As Integer
    For Each ws In ThisWorkbook.Worksheets
    Application.ScreenUpdating = False
    With ws
        .unprotect Password:="mypasswords"
    End With
        'checks if required tab. only required tabs have A10 with that value'
        If Range("A10").Value = "Big List" Then
        LastCol = .Cells(11, .[U][B]Columns[/B][/U].Count).End(xlToLeft).Column
        'Shows confirmation with last input date'
            If MsgBox("Latest input date : " & Cells(10, LastCol) & "?", vbQuestion + vbYesNo) = vbNo Then
                Application.EnableEvents = True
                Exit Sub
            End If
        NextCol = LastCol + 1
        .Range(.Cells(11, LastCol), .Cells(60, LastCol)).Copy
        .Range(.Cells(11, NextCol), .Cells(60, NextCol)).Select
        ws.Paste
    Next ws

End Sub

However, I am currently getting a "Invalid or unqalified reference" error with the word in bold and underlined in the code highlighted.

Can anyone help with this? Thanks a lot.

 

[Fluff]

Hi
You have the End With statement in the wrong place.
It needs to go here

        ws.Paste
     [COLOR=#0000ff]End With[/COLOR]
     Next ws

 

[krapnek]

Hi
You have the End With statement in the wrong place.
It needs to go here

        ws.Paste
     [COLOR=#0000ff]End With[/COLOR]
     Next ws

Thanks a lot for your reply. However, now I'm getting a

"End With without With"

error. This has happened to me before but I am not sure how I fixed it, to be honest...

Any idea? It is also not highlighting any part of the code except the Sub name...

Thanks once again in advance

 

[vds1]

Try this code

Sub MAN_CopyLastWeek()


Dim ws As Worksheet
Dim LastCol As Integer
Dim NextCol As Integer


    For Each ws In ThisWorkbook.Worksheets
        Application.ScreenUpdating = False
        ws.Select
        ws.Unprotect Password:="mypasswords"
        'checks if required tab. only required tabs have A10 with that value'
        If Range("A10").Value = "Big List" Then
            LastCol = Cells(11, Columns.Count).End(xlToLeft).Column
            'Shows confirmation with last input date'
            If MsgBox("Latest input date : " & Cells(10, LastCol) & "?", vbQuestion + vbYesNo) = vbNo Then
                Application.EnableEvents = True
                Exit Sub
            End If
            NextCol = LastCol + 1
            Range(Cells(11, LastCol), Cells(60, LastCol)).Copy
            Range(Cells(11, NextCol), Cells(60, NextCol)).PasteSpecial xlPasteAll
        End If
    Next ws
End Sub

 

[krapnek]

This one takes me to the Invalid or Unqualified reference as well, as shown in my first post...

Thanks a lot as well anyway

 

[vds1]

I edited a small dot. Can you retry?

 

[Fluff]

You're also missing an End If as well, Which I suspect should go above the End With.
Alternatively use the code from vds1

 

[krapnek]

Thanks! Working almost perfectly now!

I just realized this code is giving me a msgbox for each worksheet. Is it possible that I only get one for all worksheets?

It could measure the first sheet's LastCol and use that value, no problem.

Also, how can I kill a the macro if something happens? For instance, I want that if LastCol is empty the macro cannot run...is that possible?

Thanks a lot man!!

 

[vds1]

Try something like

Sub MAN_CopyLastWeek()


Dim ws As Worksheet
Dim LastCol As Integer
Dim NextCol As Integer
Dim FirstTime As Boolean


FirstTime = True


    For Each ws In ThisWorkbook.Worksheets
        Application.ScreenUpdating = False
        ws.Select
        ws.Unprotect Password:="mypasswords"
        'checks if required tab. only required tabs have A10 with that value'
        If Range("A10").Value = "Big List" Then
            LastCol = Cells(11, Columns.Count).End(xlToLeft).Column
            'Shows confirmation with last input date'
            If FirstTime = True Then
                If MsgBox("Latest input date : " & Cells(10, LastCol) & "?", vbQuestion + vbYesNo) = vbNo Then
                    Application.EnableEvents = True
                    Exit Sub
                End If
                FirstTime = False
            End If
            
            If LastCol = 1 Then
                If MsgBox("'" & ws.Name & "'  Having problems . Kill Macro?", vbYesNo) = vbYes Then Exit Sub
            End If
            NextCol = LastCol + 1
            Range(Cells(11, LastCol), Cells(60, LastCol)).Copy
            Range(Cells(11, NextCol), Cells(60, NextCol)).PasteSpecial xlPasteAll
        End If
    Next ws
End Sub

 

[krapnek]

I've meanwhile made it work with the following code:

Sub MAN_CopyLastWeek()


Dim ws As Worksheet
Dim LastCol As Integer
Dim NextCol As Integer

Sheets("1").Select
LastCol = Cells(11, Columns.Count).End(xlToLeft).Column
'Kills macro if no percentage introduced in first date"
If Range("G11").Value = "" Then
MsgBox ("No data introduced. Please introduce Health Data in sheet to start."), vbOKOnly
Exit Sub
End If
'Shows confirmation with last input date'
If MsgBox("ATTENTION. ALL WORKSHEETS MUST HAVE DATA INPUT. Latest input date : " & Cells(10, LastCol) & "?", vbQuestion + vbYesNo) = vbNo Then
Application.EnableEvents = True
Exit Sub
End If

    For Each ws In ThisWorkbook.Worksheets
        Application.ScreenUpdating = False
        ws.Select
        ws.unprotect Password:="mypasswords"
        'checks if required tab. only required tabs have A10 with that value'
        If Range("A10").Value = "Big List" Then
            LastCol = Cells(11, Columns.Count).End(xlToLeft).Column
            'Kills macro if no percentage introduced in first date"
            If Range("G11").Value = "" Then
                MsgBox ("No data introduced. Please introduce Health Data in shown sheet"), vbOKOnly
                Exit Sub
            End If
            NextCol = LastCol + 1
            Range(Cells(11, LastCol), Cells(60, LastCol)).Copy
            Range(Cells(11, NextCol), Cells(60, NextCol)).PasteSpecial xlPasteAll
        End If
    Next ws
End Sub

Do you think my code might run into trouble when the sheet is fully populated and working? I will use this file alone mainly but might be that in the future other people need to use it...