VBA Add Text & Merge Sheets to 1 Sheet

[cjvenables]

Hello,

I am looking for a Macro that will take the name of the worksheet (off the tab), add it after the last column of data, autofill to the last row, and then merge all sheets to a new sheet in the workbook (the exisiting workbook).

I have a bunch of different contracts on different sheets for 1 customer. For example, if the last column of data is in column J in the sheet, I want to add the name of the worksheet to column K, and then autofill all the way down to the last row of data. Some sheets may have more columns than others, as well as more rows than others, so I need the ranges to be flexible.

Since the customers obviously have different names, as well as the contracts, everything has to be generic.

Hope this is enough information. If not, let me know and I will happily clarify where needed.

Thanks guys!

 

[VoG]

Maqybe (untested)

Sub Difficult()
Dim ws As Worksheet, ns As Worksheet
Dim LR As Long, LC As Long
Dim i As Long
For Each ws In ActiveWorkbook.Worksheets
    LR = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    LC = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
    .Range(, Cells(1, LC + 1), Cells(LR, LC + 1)).Value = .Name
Next ws
Set ns = Worksheets.Add(xlWBATWorksheet, after:=Sheets(Sheets.Count))
For i = 1 To Worksheets.Count - 1
    Worksheets(i).UsedRange.Copy Destination:=ns.Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i
End Sub

 

[cjvenables]

@VoG

I get a compile error: invalid or unqualified reference at the LR= .cells point.

 

[VoG]

Try

Sub Difficult()
Dim ws As Worksheet, ns As Worksheet
Dim LR As Long, LC As Long
Dim i As Long
For Each ws In ActiveWorkbook.Worksheets
    With ws
        LR = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
        LC = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
        .Range(, Cells(1, LC + 1), Cells(LR, LC + 1)).Value = .Name
    End With
Next ws
Set ns = Worksheets.Add(after:=Sheets(Sheets.Count))
For i = 1 To Worksheets.Count - 1
    Worksheets(i).UsedRange.Copy Destination:=ns.Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i
End Sub

 

[cjvenables]

@VoG There is a new error:

Compile Error: Argument not Optional. The range row is now highlighted.

Thanks for your help on this!

 

[VoG]

Sorry, try

Sub Difficult()
Dim ws As Worksheet, ns As Worksheet
Dim LR As Long, LC As Long
Dim i As Long
For Each ws In ActiveWorkbook.Worksheets
    With ws
        LR = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
        LC = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
        .Range(.Cells(1, LC + 1), .Cells(LR, LC + 1)).Value = .Name
    End With
Next ws
Set ns = Worksheets.Add(after:=Sheets(Sheets.Count))
For i = 1 To Worksheets.Count - 1
    Worksheets(i).UsedRange.Copy Destination:=ns.Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i
End Sub