Macro to copy specific cells from diff worksheet

[asach1211]

Hi,

I was able to get help from another member on this issue. I just realized that I need to expand on this macro. Currently, this macro is copying a range from a different worksheet until it reaches an empty cell. The destination of this range is coming to a sheet named Journal Input. Alongside this, the macro is bringing a specific cell "C8" from that different worksheet and copying and filling down depending on what the range has brought over. This macro is also bringing values from a range of C23 and copying until it hits an empty cell.What I need is for this macro to also bring C10, C11,C12, C13, C14. I will also attach a file explaining more.

Sub PullData()

Dim ws As Worksheet: Set ws = Sheets("Journal Input")
Dim wksht As Worksheet
Dim lMasterLR As Long, lwkshtLR1 As Long, lwkshtLR2 As Long
Dim strAccount As String

On Error GoTo ErrHandler

Application.ScreenUpdating = False

For Each wksht In Worksheets
If wksht.Name <> "Journal Input" Then
lMasterLR = ws.Range("A" & Rows.Count).End(xlUp).Row
strAccount = wksht.Range("C8").Value
If wksht.Range("B23").Value <> "" Then
lwkshtLR1 = wksht.Range("B" & Rows.Count).End(xlUp).Row
wksht.Range("B23:B" & lwkshtLR1).Copy
ws.Range("A" & lMasterLR).Offset(1, 0).PasteSpecial xlPasteValues
ws.Range("B" & lMasterLR + 1).Value = strAccount
ws.Range("B" & lMasterLR + 1, "C" & ws.Range("A" & Rows.Count).End(xlUp).Row).FillDown
End If
If wksht.Range("C23").Value <> "" Then
lwkshtLR2 = wksht.Range("C" & Rows.Count).End(xlUp).Row
wksht.Range("C23:C" & lwkshtLR2).Copy
ws.Range("H" & lMasterLR).Offset(1, 0).PasteSpecial xlPasteValues
End If
End If
Next wksht

Application.ScreenUpdating = True

Debug.Print "Procedure Completed Successfully"

ErrHandler:
Debug.Print "There has been a critical error."
Application.ScreenUpdating = True

[davesexcel]

Give this a try:

Please Login or Register  to view this content.

[asach1211]

THANK YOU! it worked!