How do I adjust the code so that I posts in CDR A3 rather than A2? Combines two worksheets into one worksheets posting values.

Status
Not open for further replies.

NHagedorn

New Member
Joined
May 11, 2012
Messages
37
Office Version
  1. 365
Platform
  1. Windows
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
 
Last edited:

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
try this:

Code:
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 + 2 '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
 
Upvote 0
Code:
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("A3: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
 
Upvote 0
Status
Not open for further replies.

Forum statistics

Threads
1,223,886
Messages
6,175,198
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top