Copy Range (Last Row/Last Column) of Data

[BrittKnee]

Hi,

I am trying to merge multiple sheets into a single worksheet within the same workbook. I can't figure out why my code is only pasting in the first column and not the whole data set in each sheet. (Bonus help would be to copy the first row (field names) from the first sheet only). Below is the code I am currently using:

Set wrk = ActiveWorkbook 'Working in active workbook
Set sht = wrk.Sheets(2)

 'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(After:=Sheets("Macro"))
 'Rename the new worksheet
trg.Name = "Raw Data" & "_" & Format(Date, "mmdd")
 'Get column headers from the first worksheet
 'Column count first
Set sht = wrk.Sheets(2)
colCount = sht.Cells(1, 255).End(xlToLeft).Column

With trg.Cells(1, 1).Resize(1, colCount)
    .Value = sht.Cells(1, 1).Resize(1, colCount).Value
     'Set font as bold
    .Font.Bold = True
End With

 'We can start loop
For Each sht In wrk.Worksheets
If sht.Name <> "Macro" Then

     'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
    Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
        'Put data into the Master worksheet
    trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End If
Next sht
 'Fit the columns in Master worksheet
trg.Columns.AutoFit

 

[HaHoBe]

Hi BrittKnee,

in the comments to the code you refer to the first worksheet but the codelines refer to the second sheet. Please check the sheets 1 and 2 for the number of columns.. Or is the sheet Macro the first sheet in the workbook?

Sub MrE1217279_2()
'https://www.mrexcel.com/board/threads/copy-range-last-row-last-column-of-data.1217279/

Dim wkbAct As Workbook
Dim wksSh2 As Worksheet
Dim wksTarg As Worksheet
Dim lngNumCols As Long
Dim rng As Range
Dim strNewShName As String

Set wkbAct = ActiveWorkbook 'Working in active workbook
strNewShName = "Raw Data_" & Format(Date, "mmdd")

If IsError(Evaluate(Chr(34) & strNewShName & "!A1" & Chr(34))) Then
 'Add new worksheet as the last worksheet if sheet does not exist
  Set wksTarg = wkbAct.Worksheets.Add(After:=Sheets("Macro"))
 'Rename the new worksheet
  wksTarg.Name = strNewShName
Else
  'grab sheet and clearcontents
  Set wksTarg = Sheets(strNewShName)
  wksTarg.Cells.ClearContents
End If
' Get column headers from the second worksheet
 'Column count first
Set wksSh2 = wkbAct.Worksheets(2)
lngNumCols = wksSh2.Cells(1, Columns.Count).End(xlToLeft).Column

With wksTarg.Cells(1, 1).Resize(1, lngNumCols)
  .Value = wksSh2.Cells(1, 1).Resize(1, lngNumCols).Value
   'Set font as bold
  .Font.Bold = True
End With

 'We can start loop
For Each wksSh2 In wkbAct.Worksheets
  'print name and number of last column to Immediate Window
  Debug.Print wksSh2.Name & ", last column on row 1: " & wksSh2.Cells(1, Columns.Count).End(xlToLeft).Column
  'Exclude the sheets Macro and the target sheet from copying
  If wksSh2.Name <> "Macro" And wksSh2.Name <> wksTarg.Name Then
     'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
    Set rng = wksSh2.Range(wksSh2.Cells(2, 1), wksSh2.Cells(Rows.Count, 1).End(xlUp).Resize(, lngNumCols))
        'Put data into the Master worksheet
    wksTarg.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
  End If
Next wksSh2
 'Fit the columns in Master worksheet
wksTarg.Columns.AutoFit

Set rng = Nothing
Set wksTarg = Nothing
Set wksSh2 = Nothing
Set wkbAct = Nothing
End Sub

Ciao,
Holger

 

[BrittKnee]

Hi,

Thanks for your response. "Macro" is the first sheet in the workbook. It seems the code does loop through all but the first sheet (macro), but it only copies the first column from each sheet. I think it has to do with the range, but I can't seem to get it to work.

 

[HaHoBe]

Hi BrittKnee,

if macro is the first sheet you would insert the new sheet as the second on getting the last column. The result of an empty sheet should always be 1. So maybe you change the index from 2 (newly inserted sheet) to any other digit or something like Worksheets.Count for the index of the last worksheet.

Ciao,
Holger

 

[BrittKnee]

Got it! Thanks! Here is the code I ended up using successfully:

Dim sht As Worksheet
Dim trg As Worksheet
Dim rng As Range
Dim colCount As Integer

'Create new sheet and combine tabs

Set wrk = ActiveWorkbook 'Working in active workbook
Set sht = wrk.Sheets(Worksheets.Count)

 'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(After:=Sheets("Macro"))
 'Rename the new worksheet
trg.Name = "Raw Data" & "_" & Format(Date, "mmdd")
 'Get column headers from the first worksheet
 'Column count first
Set sht = wrk.Sheets(Worksheets.Count)
colCount = sht.Cells(1, Columns.Count).End(xlToLeft).Column

With trg.Cells(1, 1).Resize(1, colCount)
    .Value = sht.Cells(1, 1).Resize(1, colCount).Value
     'Set font as bold
    .Font.Bold = True
End With

 'We can start loop
For Each sht In wrk.Worksheets
If sht.Name <> "Macro" And sht.Name <> trg.Name Then

     'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
    Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(Rows.Count, 1).End(xlUp).Resize(, colCount))
        'Put data into the Master worksheet
    trg.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End If
Next sht
 'Fit the columns in Master worksheet
trg.Columns.AutoFit

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

[HaHoBe]

Hi BrittKnee,

one more word on your code. You use

Set sht = wrk.Sheets(Worksheets.Count)

which is fine as long as there are only worksheets in the workbook. I have got used to apply the TypeName of the collection as well to avoid any problems and would recommend to alter the line to read

Set sht = wrk.Workheets(Worksheets.Count)

so that the referenced sheet will always be the one you intended it to be (and not a chart sheet which was entered by hitting the short cut for this).

Glad I could be of some help on this thread.
Holger

 

[BrittKnee]

Thanks!