Finding a column in one sheet and pasting in another sheet- ones I found dont work

Hi Everyone,
I hope to get a reply soon this is my first time on here although I have been here for a while, sorry.

My goal is to find a column header name "Current" which could be ANYWHERE in a worksheet (worksheet name-- >"00-1820080") and paste it to another sheet (worksheet name ---> "Upload") on column I.
I have the following formulas but they failed to solve my problem, they keep posting Column I from (worksheet name-- >"00-1820080") to Column I on (worksheet name ---> "Upload") ... I don't want that:

'Look for "Current" copy and then Paste on Upload
Dim i As Integer, j As Integer, LR As Long
With Sheets("00-1820080")
    For i = 1 To 12
        If .Cells(1, i).Value Like "Current" Then
            LR = .Cells(Rows.Count, i).End(xlUp).Row
            j = j + 9
            .Range(.Cells(2, i), .Cells(LR, i)).Copy Destination:=Sheets("Upload").Cells(2, j)
        End If
    Next i
End With

AND I have tried this following formula as well .. bother don't work .. first one was working fine for a while and not it doesn't work :S

Dim s1 As Worksheet, s2 As Worksheet
 Set s1 = Sheets("00-1820080")
 Set s2 = Sheets("Upload")
 s1.Activate
 Range("A1").Select
 s1.Rows("1:1").Find(What:="Current", After:=ActiveCell, LookIn:=xlFormulas, _
         LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
         MatchCase:=False, SearchFormat:=False).Activate
 c = ActiveCell.Column
 s1.Columns(c).Copy s2.Range("I1")
 End Sub

Reduce your sample workbook to just what you need to show what you have, and what you want. Remove anything that does not directly relate to your question, then try the upload again

I have done that over and over again to the point where my workbook was 600kb and it still didn't work.

I can paste all my code below...

 Sub Upload()


'Create Sheet
  Sheets("00-1820080").Select
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = "Upload"
  
  
'Headings on "Upload" tab
    Sheets("Upload").Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "COMPANYID"

    Range("B1").Select
    ActiveCell.FormulaR1C1 = "COMPANY NAME"

    Range("C1").Select
    ActiveCell.FormulaR1C1 = "BACHNAME"

    Range("d1").Select
    ActiveCell.FormulaR1C1 = "JRNENTRY"
    
    Range("e1").Select
    ActiveCell.FormulaR1C1 = "TRXTYPE"

    Range("f1").Select
    ActiveCell.FormulaR1C1 = "REFERAN"
    
    Range("g1").Select
    ActiveCell.FormulaR1C1 = "GLACCTNUMB"

    Range("h1").Select
    ActiveCell.FormulaR1C1 = "ACCOUNTNAME"
    
    Range("i1").Select
    ActiveCell.FormulaR1C1 = "DEBIT"
    
    Range("j1").Select
    ActiveCell.FormulaR1C1 = "CREDIT"
    
    Range("k1").Select
    ActiveCell.FormulaR1C1 = "DATE"

    Range("l1").Select
    ActiveCell.FormulaR1C1 = "REVERSING DATE"

    Range("m1").Select
    ActiveCell.FormulaR1C1 = "DISTRIBUTIONREF"
    
    Range("n1").Select
    ActiveCell.FormulaR1C1 = "SQLNE"
    
    Range("o1").Select
    ActiveCell.FormulaR1C1 = "AA_AMOUNT"
    
    Range("p1").Select
    ActiveCell.FormulaR1C1 = "TRX_DIM"
    
    Range("q1").Select
    ActiveCell.FormulaR1C1 = "TRX_DIM_CODE"

    Range("r1").Select
    ActiveCell.FormulaR1C1 = "SUB_LOOKUP_ID"
    
    Range("s1").Select
    ActiveCell.FormulaR1C1 = "RDEBIT"
    
    Range("t1").Select
    ActiveCell.FormulaR1C1 = "RCREDIT"
    
'copy/paste numbers from recon to upload
Sheets("00-1820080").Select
ActiveSheet.Range("$A$1:$X$138").AutoFilter Field:=1, Criteria1:="CR"

'----------------------------------------------------------------------------------------TROUBLE IS WITH THE CODE BELOW IMMEDIATELY BELOW THIS LINE
'Look for "Current" copy and then Paste on Upload
Dim i As Integer, j As Integer, LR As Long
With Sheets("00-1820080")
    For i = 1 To 12
        If .Cells(1, i).Value Like "Current" Then
            LR = .Cells(Rows.Count, i).End(xlUp).Row
            j = j + 9
            .Range(.Cells(2, i), .Cells(LR, i)).Copy Destination:=Sheets("Upload").Cells(2, j)
        End If
    Next i
End With

Sheets("00-1820080").Select
ActiveSheet.ShowAllData

'Take out CR to have the vendor names pasted on upload (REFERAN)
Sheets("00-1820080").Select
ActiveSheet.Range("$A$13:$T$763").AutoFilter Field:=1, _
        Criteria1:="<>CR", _
        Operator:=xlAnd
Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
Sheets("Upload").Range("F2")

'Change Numbers from negative to positive for Upload tab
    
Sheets("Upload").Select
Dim Lastrow As Integer
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For Each Cell In Range("I2:I" & Lastrow)
If Cell.Value < 0 Then
    Cell.Value = Abs(Cell.Value)
End If
Next Cell

'Add ATECH (COMPANYID)
Finalrow = Cells(Rows.Count, "I").End(xlUp).Row
Range("A2:A" & Finalrow).Formula = "=FORM!$B$2"
Range("A2").Copy Destination:=Range("A2:A" & Finalrow)
    
'Add Amherst InsightLabs LLC (COMPANY NAME)
Finalrow = Cells(Rows.Count, "I").End(xlUp).Row
Range("B2:B" & Finalrow).Formula = "Amherst InsightLabs LLC"
Range("B2").Copy Destination:=Range("B2:B" & Finalrow)

'Add PREPAIDS (BACHNAME)
Finalrow = Cells(Rows.Count, "I").End(xlUp).Row
Range("C2:C" & Finalrow).Formula = "=FORM!$B$7"
Range("C2").Copy Destination:=Range("C2:C" & Finalrow)
    
'Add "1" (JRNENTRY)
Sheets("Upload").Select
Range("D2").Select
ActiveCell.FormulaR1C1 = "1"
LR = Range("I" & Rows.Count).End(xlUp).Row
Range("D2").AutoFill Destination:=Range("D2:D" & LR), Type:=xlFillSeries
    
'Add "0" (TRXTYPE)
Finalrow = Cells(Rows.Count, "I").End(xlUp).Row
Range("E2:E" & Finalrow).Formula = "=FORM!$B$5"
Range("E2").Copy Destination:=Range("E2:E" & Finalrow)
    
'Add (GLACCTNUMB)
 Sheets("00-1820080").Select
ActiveSheet.ShowAllData

'Take out CR to have the GL Account number pasted on upload
Sheets("00-1820080").Select
ActiveSheet.Range("$A$13:$T$763").AutoFilter Field:=1, _
        Criteria1:="<>CR", _
        Operator:=xlAnd
Range("C2:C" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
Sheets("Upload").Range("G2")
    
    
'Add (ACCOUNTNAME)
Sheets("Upload").Select
Finalrow = Cells(Rows.Count, "I").End(xlUp).Row
Range("H2:H" & Finalrow).Formula = "=VLOOKUP(C[-1],ChartofAccounts!C[-7]:C[-6],2,0)"
Range("H2").Copy Destination:=Range("H2:H" & Finalrow)


'Add (CREDIT)
Finalrow = Cells(Rows.Count, "I").End(xlUp).Row
Range("J2:J" & Finalrow).Formula = "0"
Range("J2").Copy Destination:=Range("J2:J" & Finalrow)

'Add (DATE)
Finalrow = Cells(Rows.Count, "I").End(xlUp).Row
Range("K2:K" & Finalrow).Formula = "=FORM!$B$3"
Range("K2").Copy Destination:=Range("K2:K" & Finalrow)


'Take out CR to have the vendor names pasted on upload (REFERAN)
Sheets("00-1820080").Select
ActiveSheet.ShowAllData

Sheets("00-1820080").Select
ActiveSheet.Range("$A$13:$T$763").AutoFilter Field:=1, _
        Criteria1:="<>CR", _
        Operator:=xlAnd
Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
Sheets("Upload").Range("M2")

'(SQLNE) Fill Series Numbers 1,2,3,4,5...
Sheets("Upload").Select
Range("N2").Select
ActiveCell.FormulaR1C1 = "1"
LR = Range("I" & Rows.Count).End(xlUp).Row
Range("N2").AutoFill Destination:=Range("N2:N" & LR), Type:=xlFillSeries


'(RDEBIT) AND (RCREDIT) Column S
Dim LS As Long
Range("S2").Select
ActiveCell.FormulaR1C1 = "=ROUND(RC[-10],2)"
LR = Range("I" & Rows.Count).End(xlUp).Row
Range("S2").AutoFill Destination:=Range("S2:S" & LR), Type:=xlFillSeries

Dim LT As Long
Range("t2").Select
ActiveCell.FormulaR1C1 = "=ROUND(RC[-10],2)"
LR = Range("I" & Rows.Count).End(xlUp).Row
Range("t2").AutoFill Destination:=Range("t2:t" & LR), Type:=xlFillSeries


'Combine
Call newother_

'Negative to POSITIVE
Sheets("Upload").Select
Dim Lastrow1 As Integer
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For Each Cell In Range("I2:I" & Lastrow)
If Cell.Value < 0 Then
    Cell.Value = Abs(Cell.Value)
End If
Next Cell

'(SQLNE) Fill Series Numbers 1,2,3,4,5...
Sheets("Upload").Select
Range("N2").Select
ActiveCell.FormulaR1C1 = "1"
LR = Range("I" & Rows.Count).End(xlUp).Row
Range("N2").AutoFill Destination:=Range("N2:N" & LR), Type:=xlFillSeries

'FOrmatting Upload tab
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("H:H").Select
    Selection.Copy
    Columns("F:F").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Columns("M:M").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
' (BACHNAME)

Finalrow = Cells(Rows.Count, "I").End(xlUp).Row
Range("A2:A" & Finalrow).Formula = "=FORM!$B$2"
Range("A2").Copy Destination:=Range("A2:A" & Finalrow)

'DELETE UPLOAD2
Application.DisplayAlerts = False

Sheets("Upload2").Select

ActiveWindow.SelectedSheets.Delete

Application.DisplayAlerts = True




End Sub

You need to use code tags when posting code, see point 1 of my signature.

I will add them for you - this time

edit: OK, I see that you did try to use code tags, you didnt close them

The / goes before the CODE, not after

Hi Ali,

Try John's program with this adjustment:

Sub alirizvil() 'John H. Davis
Dim x As Range
Dim y As Long
Dim ws As Worksheet, ws2 As Worksheet
Set ws = Sheets("00-1820080")
Set ws2 = Sheets("Upload")
Set x = ws.Rows(1).Find("Current", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=xlFalse)
    If Not x Is Nothing Then
    y = ws.Cells(Rows.Count, x.column).End(3).row
        ws.Range(ws.Cells(2, x.column), ws.Cells(y, x.column)).copy ws2.Range("I1")
    End If
Set x = Nothing
End Sub

You're welcome - hope it works

Hi Ali,

Try this - it will search the first 5 rows:

Sub alirizvilX() 'John H. Davis
Dim x As Range
Dim y As Long
Dim ws As Worksheet, ws2 As Worksheet
Set ws = Sheets("00-1820080")
Set ws2 = Sheets("Upload")
Set x = ws.Rows("1:5").Find("Current", LookIn:=xlValues, lookat:=xlPart, MatchCase:=xlNo)
    If Not x Is Nothing Then
    y = ws.Cells(Rows.Count, x.column).End(3).row
        ws.Range(ws.Cells(2, x.column), ws.Cells(y, x.column)).copy ws2.Range("I1")
    End If
Set x = Nothing
End Sub

Hi Ali,

Instead of the header reading "Current" it probably reads "Current " and as such wouldn't be seen as a match.

You're welcome and thanks for the rep!

*Your header probably had trailing space(s).