Copying the Data from Sheet"x" (Source) to Sheet"y" (Destination)based on a condition

[karimdude]

Hi All,
I just wanted to know how to do this and what's wrong in this script:

I need to copy data from a range (Row) on a sheet and paste it into another sheet as column based on a date that matches the header of the column:


'In this example I am Copying the Data from Sheet"x" (Source) to Sheet"y" (Destination)based on a condition on a specific cell
Sub sbCopyRangeToAnotherSheet()
Dim TotalRows As Long
Dim i As Long
Sheets("Export Gas").Select
TotalRows = ActiveSheet.UsedRange.Columns.Count
For i = 1 To TotalRows
If Cells(1, i).Value = Sheets("Daily Export Gas").Cells(2, 7).Value Then
Sheets("Daily Export Gas").Range("D8:J8").Copy
Sheets("Export Gas").Range("i2:i8").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Else
End If
Next
End Sub


Help Please

 

[mumps]

Try:

Sub sbCopyRangeToAnotherSheet()
    Application.ScreenUpdating = False
    Dim lCol As Long
    lCol = Sheets("Export Gas").Range("IV1").End(xlToLeft).Column
    Dim foundVal As Range
    Set foundVal = Sheets("Export Gas").Rows(1).Find(Sheets("Daily Export Gas").Cells(2, 7), LookIn:=xlValues, lookat:=xlWhole)
    If Not foundVal Is Nothing Then
        Sheets("Daily Export Gas").Range("D8:J8").Copy
        Sheets("Export Gas").Range("I2").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    End If
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
 End Sub

 

[karimdude]

Didn't work for me..

Any one can help!!!

 

[mumps]

I think that it would be much easier to follow if I could see how your data is organized. Perhaps you could upload a copy of your file to a free site such as www.box.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets.

 

[karimdude]

ADVERTISEMENT

I think that it would be much easier to follow if I could see how your data is organized. Perhaps you could upload a copy of your file to a free site such as www.box.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets.

Please find below the link to the file:


https://app.box.com/s/yctk0u38qc0otgbovvk9exkqcpo8i8v5

Basically, i want the second sheet to copy information from the first sheet every day. At the end of the month we will get all daily reports in one sheet.

 

[mumps]

Try:

Sub sbCopyRangeToAnotherSheet()
    Application.ScreenUpdating = False
    Dim lCol As Long
    lCol = Sheets("Export Gas").Range("IV1").End(xlToLeft).Column
    Dim x As Long
    x = 8
    Dim y As Long
    Dim bottomA As Long
    bottomA = Sheets("Export Gas").Range("A" & Rows.Count).End(xlUp).Row
    Dim foundDate As Range
    Set foundDate = Sheets("Export Gas").Rows(1).Find(Int(Sheets("Daily Export Gas").Cells(2, 7)), LookIn:=xlValues, lookat:=xlWhole)
    If Not foundDate Is Nothing Then
        For y = 2 To bottomA Step 7
            Sheets("Daily Export Gas").Range("D" & x & ":J" & x).Copy
            Sheets("Export Gas").Cells(y, foundDate.Column).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            x = x + 1
        Next y
    End If
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
 End Sub

 

[karimdude]

Thank you very much man...
The code was perfect and it works fine. I have even found a mistake on my sheet thanks to the code.

 

[mumps]

My pleasure.