Trying to adjust code so that it posts .values on line A3 rather than A2... Thank you
I adjusted 'first empty row from +1 to +2 but gives me a blank row between two sheets....
Sub CDRCombine()
Application.ScreenUpdating = False
Dim wsCDR As Worksheet
Dim LastRowWs As Long
Dim LastRowCDR As Long
Dim StartRowCDR As Long
Set wsCDR = ThisWorkbook.Worksheets("CDR")
LastRowCDR = wsCDR.Cells(wsCDR.Rows.Count, "A").End(xlUp).Row + 1
wsCDR.Range("A2:AK" & LastRowCDR).Clear
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Acct Setup" And Ws.Name <> "Pres Setup" And Ws.Name <> "Data" And Ws.Name <> "Stuff" And Ws.Name <> "Next Injection" And Ws.Name <> "Pull Through" And Ws.Name <> "CDR" And Ws.Name <> "Acct-W-Syr-Prolia(spec)" And Ws.Name <> "Pres-W-Syr-Prolia(spec)" Then
LastRowWs = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row
StartRowCDR = wsCDR.Cells(wsCDR.Rows.Count, "A").End(xlUp).Row + 1 'first empty row
wsCDR.Range("A" & StartRowCDR).Resize(LastRowWs - 1, 37).Value = Ws.Range("A2:AK" & LastRowWs).Value
LastRowCDR = wsCDR.Cells(wsCDR.Rows.Count, "A").End(xlUp).Row
wsCDR.Range("E" & StartRowCDR & ":E" & LastRowCDR) = Ws.Name
End If
Next
Application.ScreenUpdating = True
End Sub
I adjusted 'first empty row from +1 to +2 but gives me a blank row between two sheets....
Sub CDRCombine()
Application.ScreenUpdating = False
Dim wsCDR As Worksheet
Dim LastRowWs As Long
Dim LastRowCDR As Long
Dim StartRowCDR As Long
Set wsCDR = ThisWorkbook.Worksheets("CDR")
LastRowCDR = wsCDR.Cells(wsCDR.Rows.Count, "A").End(xlUp).Row + 1
wsCDR.Range("A2:AK" & LastRowCDR).Clear
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Acct Setup" And Ws.Name <> "Pres Setup" And Ws.Name <> "Data" And Ws.Name <> "Stuff" And Ws.Name <> "Next Injection" And Ws.Name <> "Pull Through" And Ws.Name <> "CDR" And Ws.Name <> "Acct-W-Syr-Prolia(spec)" And Ws.Name <> "Pres-W-Syr-Prolia(spec)" Then
LastRowWs = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row
StartRowCDR = wsCDR.Cells(wsCDR.Rows.Count, "A").End(xlUp).Row + 1 'first empty row
wsCDR.Range("A" & StartRowCDR).Resize(LastRowWs - 1, 37).Value = Ws.Range("A2:AK" & LastRowWs).Value
LastRowCDR = wsCDR.Cells(wsCDR.Rows.Count, "A").End(xlUp).Row
wsCDR.Range("E" & StartRowCDR & ":E" & LastRowCDR) = Ws.Name
End If
Next
Application.ScreenUpdating = True
End Sub
Last edited: