kopier hele rækken fra et ark til et andet, hvis condition passer

En makro ville nok kunne udføre det automatisk. Hvad er conditionen?

Og så velkommen til...

Jeg går ud fra, at der i din månedlige fils (herefter kaldet MD_01.xls, MD_02.xls, osv.) sidste regneark (filens hovedark) er konsolideret/samlet månedens aktivitet for hver sælger.

Mener du: Du vil stå i MDL.xls og fordele annoncørerne ud i deres respektive filer (her kaldet ANN_O1, ANN_02, osv.), hvis de eksisterer i MDL.xls ?

Er det dette, du mener ?

Mvh finb

Hej,

det var hurtigt der kom svar :)

@supertekst, jeg tror også en macro vil kunne hjælpe, men har ikke fundet en der virker ordentligt, konditionen er annoncørs navn.

@finb, md_01.xsl indeholder i dag en masse ark med annoncørens navne og MD_02.xsl, indeholder en oversigt over hvor meget hver annoncør har leveret i forskellige kategorier. Meningen er, idag, at jeg tager finder annoncøren i md_02.xsl, der optræder flere gange, da han kan levere i flere kategorier, og copy/paster det over i md_01.xsl under han ark.
jeg tænker jeg kan stå i md_01.xsl under arket for en annoncør, og søge i md_02.xsl, og hvis annoncørens navn eksistere, så kopierer den automatisk hele rækken ind i arket (md_01.xsl)

Hvis du sender en lille model af filer - så skal jeg prøve at skrive makroen.

@-adresse under min profil.

Hej Peter,

tak super hjælp :)

Const alleSti = "C:\Documents and Settings\pb.KHNBPB\Skrivebord\923015_LeadsOpdatering\MedTekst\"
Dim alleXls As Object
Const alleFilNavn = "alle_leads.xls"                     

Const enkelteSti = "C:\Documents and Settings\pb.KHNBPB\Skrivebord\923015_LeadsOpdatering\MedTekst\"
Dim enkelteXls As Object
Const enkelteFilNavn = "med_de_enkelte_annoncører.xls"     

Dim antal As Long
Public Sub opdaterAnnoncører()
On Error GoTo lukAlle
    Application.ScreenUpdating = False
   
    antal = 0
   
    Set enkelteXls = ActiveWorkbook
    enkelteXls.Application.DisplayAlerts = False
   
    Set alleXls = CreateObject("Excel.Application")
    With alleXls
        .Workbooks.Open alleSti + alleFilNavn
'        .Visible = True
       
        traverserAlle
    End With
   
lukAlle:
    alleXls.Application.DisplayAlerts = False
    alleXls.Application.Quit
    Set alleXls = Nothing
   
    Set enkelteXls = Nothing
    Application.ScreenUpdating = True
   
    MsgBox ("Opdatering afsluttet - antal: " & CStr(antal))
End Sub
Private Sub traverserAlle()
Dim alleRækker As Long, ræk As Long, faneNr As String
    With alleXls
        .Sheets(1).Activate
       
        alleRækker = .ActiveCell.SpecialCells(xlLastCell).Row
   
        For ræk = 4 To alleRækker
            If .Range("D" & ræk) <> "" Then
                faneNr = .Range("D" & ræk)
                               
                .Rows(CStr(ræk) & ":" & CStr(ræk)).Select
                .Selection.Copy

                opdaterAnnoncør faneNr
            End If
   
        Next ræk
    End With
End Sub
Private Sub opdaterAnnoncør(faneNr)
Dim ræk As Long, antalRækker As Long
On Error GoTo fejl

    With enkelteXls
        .Sheets(faneNr).Activate
               
        For ræk = 3 To 65000
            If .ActiveSheet.Range("A" & ræk) = "" Then
                antal = antal + 1
                Rows(CStr(ræk) & ":" & CStr(ræk)).Select
                ActiveSheet.Paste
               
                Application.CutCopyMode = False
                Exit Sub
            End If
        Next ræk
    End With
    Exit Sub
   
fejl:
    MsgBox "Arket: " & faneNr & " findes ikke!"
End Sub