VBA: Code MONSTROSITY, EMBARRASSED TO SHOW BUT "NEED HELP".

B

bamaisgreat

Well-known Member
Joined
Jan 23, 2012
Messages
826
Office Version
  1. 365
Platform
  1. Windows
The code I have below is a major overkill but It works except there is a couple of bugs. The first is when I run the code, on the last line((Set rngfil = Range("A20,B20,C20,D20,J20,R20,U20"))) it puts in the "-" in the Range of cells, I dont need that. Each line may not always have data in it and sometimes there may only be a few of the cells with data in them. The reason I chose the "-" is so no cell will be empty to prevent the line of cells from getting out of line. Any help is appreciated, Thanks

Code: 
Sub ArchiveIt()
'next line adds character into empty cell'
Dim rngfil As Range, cell As Range
Dim NR As Long
Set ws1 = ActiveWorkbook.Sheets("JOB FORM")
Set rngfil = Range("A4,B4,C4,D4,J4,R4,U4")
Set rngfil = Range("A5,B5,C5,D5,J5,R5,U5")
Set rngfil = Range("A6,B6,C6,D6,J6,R6,U6")
Set rngfil = Range("A7,B7,C7,D7,J7,R7,U7")
Set rngfil = Range("A8,B8,C8,D8,J8,R8,U8")
Set rngfil = Range("A9,B9,C9,D9,J9,R9,U9")
Set rngfil = Range("A10,B10,C10,D10,J10,R10,U10")
Set rngfil = Range("A11,B11,C11,D11,J11,R11,U11")
Set rngfil = Range("A12,B12,C12,D12,J12,R12,U12")
Set rngfil = Range("A13,B13,C13,D13,J13,R13,U13")
Set rngfil = Range("A14,B14,C14,D14,J14,R14,U14")
Set rngfil = Range("A15,B15,C15,D15,J15,R15,U15")
Set rngfil = Range("A16,B16,C16,D16,J16,R16,U16")
Set rngfil = Range("A17,B17,C17,D17,J17,R17,U17")
Set rngfil = Range("A18,B18,C18,D18,J18,R18,U18")
Set rngfil = Range("A19,B19,C19,D19,J19,R19,U19")
Set rngfil = Range("A20,B20,C20,D20,J20,R20,U20")
For Each cell In rngfil
 If cell.Value = vbNullString Then
 cell.Value = "-"
 End If
 Next cell
Filename = "H:\Burney Table\CUTTING FORMS (Protected by QC)\fmi archive\My Book.xls"
Workbooks.Open (Filename)
 
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A4").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B4").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C4").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D4").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J4").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R4").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T4").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U4").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A5").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B5").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C5").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D5").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J5").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R5").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T5").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U5").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A6").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B6").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C6").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D6").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J6").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R6").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T6").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U6").Value
 NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A7").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B7").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C7").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D7").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J7").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R7").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T7").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U7").Value
 NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A8").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B8").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C8").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D8").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J8").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R8").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T8").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U8").Value
 NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A9").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B9").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C9").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D9").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J9").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R9").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T9").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U9").Value
 NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A10").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B10").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C10").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D10").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J10").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R10").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T10").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U10").Value
 NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A11").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B11").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C11").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D11").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J11").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R11").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T11").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U11").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A12").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B12").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C12").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D12").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J12").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R12").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T12").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U12").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A13").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B13").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C13").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D13").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J13").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R13").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T13").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U13").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A14").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B14").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C14").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D14").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J14").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R14").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T14").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U14").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A15").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B15").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C15").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D15").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J15").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R15").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T15").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U15").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A16").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B16").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C16").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D16").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J16").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R16").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T16").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U16").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A17").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B17").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C17").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D17").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J17").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R17").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T17").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U17").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A18").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B18").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C18").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D18").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J18").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R18").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T18").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U18").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A19").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B19").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C19").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D19").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J19").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R19").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T19").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U19").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A20").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B20").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C20").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D20").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J20").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R20").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T20").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U20").Value

   
    ActiveWorkbook.save
    'ActiveWorkbook.Close
End Sub
 
Sort by date Sort by votes
I didn't realize you needed it to stop if there were empty rows (or that there would even be empty rows)
Try this:
Code: 
Sub ArchiveIt()
'next line adds character into empty cell'
Dim rngfil As Range, cell As Range
Dim NR As Long, I as Long
Set ws1 = ActiveWorkbook.Sheets("JOB FORM")
Set rngfil = Range("A4:D20,J4:J20,R4:R20,U4:U20")
For Each cell In rngfil
     If cell.Value = vbNullString Then
         cell.Value = "-"
     End If
 Next cell
For Each cell In Range("A4:A20")
    If cell & cell.Offset(0,1) & cell.Offset(0,2) & cell.Offset(0,3) & cell.Offset(0,4) & cell.Offset(0,10) & _
        cell.Offset(0,18) = "-------" Then
        range("A" & cell.Row & ":D20,J" & cell.Row & ":J20,R" & cell.Row & ":R20,U" & cell.Row & ":U20").ClearContents
        Goto 123
    End If
Next cell
123:
Filename = "H:\Burney Table\CUTTING FORMS (Protected by QC)\fmi archive\My Book.xls"
Workbooks.Open (Filename)
 
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
For I =0 to 16
    Sheets("Sheet1").Range("A" & NR + I).Value = ws1.Range("A" & I+4).Value
    Sheets("Sheet1").Range("B" & NR + I).Value = ws1.Range("B" & I+4).Value
    Sheets("Sheet1").Range("C" & NR + I).Value = ws1.Range("C" & I+4).Value
    Sheets("Sheet1").Range("D" & NR + I).Value = ws1.Range("D" & I+4).Value
    Sheets("Sheet1").Range("E" & NR + I).Value = ws1.Range("J" & I+4).Value
    Sheets("Sheet1").Range("F" & NR + I).Value = ws1.Range("R" & I+4).Value
    Sheets("Sheet1").Range("G" & NR + I).Value = ws1.Range("T" & I+4).Value
    Sheets("Sheet1").Range("H" & NR + I).Value = ws1.Range("U" & I+4).Value
Next I
   
    ActiveWorkbook.save
    'ActiveWorkbook.Close
End Sub
 
Upvote 0

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Thanks for the info.It doesnt make much since right now but maybe later it will sink in..
 
Upvote 0
It seems to fill all cells that are empty in the ranges with the"-". It goes all the way to Row 20 filling them in. I do have the code below in the worksheet, would that have any affect on it

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
If Not Intersect(Target, Range("D4:D20")) Is Nothing Then
Application.EnableEvents = False
For Each cell In Intersect(Target, Range("D4:D20"))
If Not IsEmpty(cell) Then
Cells(cell.Row, "T").Value = Now
Else
Cells(cell.Row, "T").ClearContents
End If
Next cell
Application.EnableEvents = True
End If
End Sub
Click to expand...
 
Upvote 0
Snake does the 0 to 16 represent the amount of rows it s going down ? If so there are 17. If so try and explain as if I were 12. This all seems so greek to me.
 
Upvote 0
bamaisgreat,

Have managed to find time to take a closer look at this for you.

Firstly,
Snake does the 0 to 16 represent the amount of rows it s going down ? If so there are 17. If so try and explain as if I were 12. This all seems so greek to me.​
Click to expand...


0 to 16 is 17 numbers. Because we are coding an offset from the datum range the first offset is (0,0) ie no row or column offset so it is the datum range itself.
If the next offset is (1,0) then it is the next row down from datum range. Cell A4 offset by 0 rows =A4. Cell A4 offset by 16 rows = A20.


If I have interpreted correctly then the following code should do it.

gsistek has the second part of his code spot on and I have included it in the code below.
The first part of below checks row by row, 4 to 20 to see if all of your 7 specified cells in that row are empty.
If so it bails out and archives to your second workbook.
If not it checks each of the 7 cells in row and if blank, enters '-'


Code: 
Sub ArchiveIt()
Dim rngfil As Range, cell As Range
Dim NR As Long, I As Long
Set ws1 = ActiveWorkbook.Sheets("JOB FORM")
Set rngfil = Range("A4,B4,C4,D4,J4,R4,U4") 'first row of data to be processed
For r = 0 To 16  'row offset variable
EmptyRowCheck = ""
For Each cell In rngfil.Offset(r, 0)        'Concat values of cells in rngfil offset
EmptyRowCheck = EmptyRowCheck & cell
Next cell
If EmptyRowCheck = "" Then GoTo FoundEmptyRow  ' if "" empty row of rngfil cells found so stop putting -
For Each cell In rngfil.Offset(r, 0)  'otherwise put - in any empty cell
If cell.Value = vbNullString Then
 cell.Value = "-"
 End If
Next cell
Next r
FoundEmptyRow:  'stop putting -
' Archive values to ....
Filename = "H:\Burney Table\CUTTING FORMS (Protected by QC)\fmi archive\My Book.xls"
Workbooks.Open (Filename)
 
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
For I = 0 To 16
    Sheets("Sheet1").Range("A" & NR + I).Value = ws1.Range("A" & I + 4).Value
    Sheets("Sheet1").Range("B" & NR + I).Value = ws1.Range("B" & I + 4).Value
    Sheets("Sheet1").Range("C" & NR + I).Value = ws1.Range("C" & I + 4).Value
    Sheets("Sheet1").Range("D" & NR + I).Value = ws1.Range("D" & I + 4).Value
    Sheets("Sheet1").Range("E" & NR + I).Value = ws1.Range("J" & I + 4).Value
    Sheets("Sheet1").Range("F" & NR + I).Value = ws1.Range("R" & I + 4).Value
    Sheets("Sheet1").Range("G" & NR + I).Value = ws1.Range("T" & I + 4).Value
    Sheets("Sheet1").Range("H" & NR + I).Value = ws1.Range("U" & I + 4).Value
Next I
   
    'ActiveWorkbook.Save
    'ActiveWorkbook.Close
End Sub

When tested within the same workbook running the code twice on data in JOB FORM created the reult in Sheet1.



Excel 2007
ABCDEFGHIJKLMNOPQRSTU
4Sxx----
5----s--
6A------
7A------
8ABC--EF
9-BC----
10-BC----
11-BC----
12----w--
13
14
15
16
17
18
19
20
JOB FORM



Excel 2007
ABCDEFGH
1
2Sxx----
3----s--
4A------
5A------
6ABC--EF
7-BC----
8-BC----
9-BC----
10----w--
11Sxx----
12----s--
13A------
14A------
15ABC--EF
16-BC----
17-BC----
18-BC----
19----w--
20
Sheet1


Hope that helps.







​
 
Upvote 0
bamaisgreat,

With regards to the Worksheet_Change event code.

With your original code post# 13 it will create the time stamp in Column T in any row where the other code puts a '-' in an empty D cell.

I assume that this is not what you want?


So if you modify the WC code as below it will ignore marking an empty cell with '-' so no date stamp.


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
If Not Intersect(Target, Range("D4:D20")) Is Nothing Then
Application.EnableEvents = False
For Each cell In Intersect(Target, Range("D4:D20"))

If Not IsEmpty(cell) And Not cell = "-" Then  '*********edited*****

Cells(cell.Row, "T").Value = Now
Else
Cells(cell.Row, "T").ClearContents
End If
Next cell
Application.EnableEvents = True
End If
End Sub

I hope that sorts it all.

PS When is your 13th birthday due? :)
 
Upvote 0
Tony could there be a line of code added were the File name to each line is added in Column " I " on each line
 
Upvote 0
Tony the sheet is working great. One question ? Is there something that could be added where the current file name and location could go to another column beside each row?
Im wanting to format that row possible as a hyperlink to the orginal sheet it came from.

For I = 0 To 16
Sheets("Sheet1").Range("A" & NR + I).Value = ws1.Range("A" & I + 4).Value
Sheets("Sheet1").Range("B" & NR + I).Value = ws1.Range("B" & I + 4).Value
Sheets("Sheet1").Range("C" & NR + I).Value = ws1.Range("C" & I + 4).Value
Sheets("Sheet1").Range("D" & NR + I).Value = ws1.Range("D" & I + 4).Value
Sheets("Sheet1").Range("E" & NR + I).Value = ws1.Range("J" & I + 4).Value
Sheets("Sheet1").Range("F" & NR + I).Value = ws1.Range("R" & I + 4).Value
Sheets("Sheet1").Range("G" & NR + I).Value = ws1.Range("T" & I + 4).Value
Sheets("Sheet1").Range("H" & NR + I).Value = ws1.Range("U" & I + 4).Value
Sheets("Sheet1").Range("I" & NR + I).Value = Current File name and location ????
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
VBA compare values on different sheets.
Replies
5
Views
149
rlv01
R
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
2
Views
305
B-radK
B
J
  • Solved
VBA to compare rows in two different sheets, if match highlight cell
2
Replies
10
Views
781
kevin9999
K
S
  • Question
Date formatting issue sheet to VBA Array to Sheet
Replies
2
Views
204
MARK858
MARK858
T
  • Solved
Multiple columns into 2?
Replies
6
Views
142
Georgiboy
Georgiboy

Forum statistics

Threads
1,216,052
Messages
6,128,509
Members
449,455
Latest member
jesski

Share this page

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